VBA Skript läuft fehlerfrei, funktioniert aber nur teilweise
17.04.2025 12:16:28
tempestas
ich möchte zwei Datensätze zusammenführen.
Die Datensätze befinden sich in einem Workbook in jeweils einem Sheet.
Die Datensätze enthalten die Verkaufsmengen von Produkten einer bestimmten Klasse pro Verkäufer pro Monat. Die Produkte haben noch dazu verschiedene Packungsgrößen - all das wird separat aufgeführt.
- Datensatz_1 enthält die Daten von Mai 2022 bis Mai 2024
- Datensatz_2 enthält die Daten von Februar 2023 bis Februar 2025.
Ich möchte nun aus Datensatz_2 die Verkaufsmengen von Juni 2024 bis Februar 2025 in Datensatz_1 ergänzen.
Herausforderung: es ist inzwischen ein Produkt mit mehreren Packungsgrößen hinzugekommen (ein Produkt, das wiederum von vielen Verkäufern abgesetzt wird) und bei einigen Produkten anderen können pro Verkäufer noch Packungsgrößen hinzugekommen sein, die er vorher nicht hatte.
Ich hab mir einen unique identifier mit Hilfe der VERKETTEN-Formel gebastelt: "Verkäufer Produkt Packungsgröße". Befindet sich in Spalte "E".
Ich möchte die Spalten mit den gewünschten Daten aus Datensatz_2 (Spalten Y bis AG) in Datensatz_1 (Spalten AH bis AP) hinzufügen und dann die komplette Zeile, die kopiert wurde, in Datensatz_1 löschen.
Sub MergeData()
Dim i As Long
Dim j As Long
Dim rng1 As Range
Dim rng2 As Range
Dim strSuch As String
Dim sheetSource As Worksheet 'Datensatz_2
Dim sheetDest As Worksheet 'Datensatz_1
Set sheetSource = Workbooks("daten_merge_work_20250415_test.xlsm").Worksheets("Daten_0223_bis_0225_test")
Set sheetDest = Workbooks("daten_merge_work_20250415_test.xlsm").Worksheets("Daten_0522_bis_0524_test")
Set rng1 = sheetSource.Range("E:E") 'Spalte mit dem Identifier
Set rng2 = sheetDest.Range("E:E") 'Spalte mit dem Identifier
sheetSource.Range("Y" & 1 & ":AG" & 1).Copy Destination:=sheetDest.Range("AH" & 1 & ":AP" & 1)
For i = 2 To sheetSource.Cells(Rows.count, 1).End(xlUp).Row
'strSuch = rng1(i).Value
For j = 2 To sheetDest.Cells(Rows.count, 1).End(xlUp).Row
' If rng2(j).Value = strSuch Then
If rng2(j).Value = rng1(i).Value Then
sheetSource.Range("Y" & i & ":AG" & i).Copy Destination:=sheetDest.Range("AH" & j & ":AP" & j)
sheetDest.Range("AH" & j & ":AP" & j).Font.Color = RGB(255, 0, 0)
sheetSource.Rows(i).Delete
End If
Next j
Next i
End SubDas Skript läuft fehlerfrei, allerdings werden leider nicht alle Daten, die kopiert werden müssen, auch wirklich in Datensatz_1 kopiert. Es bleiben zuviele übrig, als dass ich das per Hand korrigieren könnte.
Ich hab in Spalte E schon nur die Werte einkopiert (also: erst den unique identifier mit der VERKETTEN-Funktion erstellt und dann kopiert und als Wert eingefügt, aber auch das hilft nicht).
Was kann ich an dem Skript verbessern, dass wirklich alle Zeilen korrekt erkannt und die Daten in Datensatz_1 übertragen werden?
Vielen Dank vorab für die Hilfe!
tempestas
Anzeige