AW: Abgleichen von Preisen
11.08.2022 11:39:15
Preisen
Hallo
>> nur leider schiebt es immer die Preise von allen Produkten in eines der Produkte!
Bei mir (mit deiner Musterdatei) nicht; da klappt das.
Vorher:
| | A | B | C | D |
| 2 | Produkt 1 | 10.08.2022 | 10:00 | 3,59 | | |
| 3 | Produkt 2 | 09.08.2022 | 09:00 | 3,50 | 10.08.2022 | 08:00 | 3,79 | |
| 4 | Produkt 3 | 08.08.2022 | 07:53 | 25,98 | 09.08.2022 | 15:32 | 27,49 | 10.08.2022 | 19:45 | 26,99 |
| | A | B | C |
| 1 | Neu Preise Eingang | | 11.08.2022 |
| 2 | | | |
| 3 | Produkt 4 | 5,49 | |
| 4 | Produkt 5 | 10,99 | |
| 5 | Produkt 1 | 4,49 | |
| 6 | Produkt 2 | 3,69 | |
| 7 | Produkt 3 | 26,99 | |
Nachher:
| | A | B | C | D |
| 2 | Produkt 1 | 10.08.2022 | 10:00 | 3,59 | 11.08.2022 | 11:29 | 4,49 | |
| 3 | Produkt 2 | 09.08.2022 | 09:00 | 3,50 | 10.08.2022 | 08:00 | 3,79 | 11.08.2022 | 11:29 | 3,69 |
| 4 | Produkt 3 | 08.08.2022 | 07:53 | 25,98 | 09.08.2022 | 15:32 | 27,49 | 10.08.2022 | 19:45 | 26,99 |
| 5 | Produkt 4 | 11.08.2022 | 11:29 | 5,49 | | |
| 6 | Produkt 5 | 11.08.2022 | 11:29 | 10,99 | | |
Das mit den Leerzeichen bei hab ich noch eliminiert
Sub Preis()
Dim TB1 As Worksheet, TB2 As Worksheet, LR As Integer, i As Integer
Dim Arr, Prod As String, Datum As Date, Zeit As String, Preis As String
Dim Z1 As Integer, LC As Integer, Zeile As Integer
Set TB1 = Sheets("Tabelle1")
Set TB2 = Sheets("Tabelle2")
Z1 = 3 ' erste Zeile mit Daten Tab2
With TB2
LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
For i = Z1 To LR
Prod = .Cells(i, 1)
Preis = Replace(.Cells(i, 2).Text, " ", "")
Datum = .Cells(1, 3)
Zeit = Format(Now, "hh:mm")
If WorksheetFunction.CountIf(TB1.Columns(1), Prod) > 0 Then 'besteht schon
'in welcher Zeile
Zeile = WorksheetFunction.Match(Prod, TB1.Columns(1), 1)
'Vergleich mit letzter Spalte
LC = TB1.Cells(Zeile, TB1.Columns.Count).End(xlToLeft).Column
Arr = Split(TB1.Cells(Zeile, LC), " | ")
'Vergleiche Preise
If Replace(Arr(2), " ", "") Preis Then
'in neue Spalte
TB1.Cells(Zeile, LC + 1) = Datum & " | " & Zeit & " | " & Preis
Else
'ist gleich also nichts machen
End If
Else 'ist neu
Zeile = TB1.Cells(.Rows.Count, "A").End(xlUp).Row + 1 'Neue Zeile
TB1.Cells(Zeile, 1) = Prod
TB1.Cells(Zeile, 2) = Datum & " | " & Zeit & " | " & Preis
End If
Next
End With
End Sub
