Wer häufig EAN Listen der Lieferanten bearbeiten muss, wird – wie ich – sicher irgendwann daran verzweifeln, dass Vaterartikel händisch angelegt werden müssen. Zusätzlich müssen die Artikel mit der Vaterartikel ID versehen, der Artikelname durch Größe und/oder Farbe ergänzt und die Artikelnummer intelligent gewählt werden. Nicht schlimm bei Listen, die dann für einige Jahre unverändert laufen, aber ein Albtraum bei zB Mode, wo die Kollektionen teilweise halbjährlich erscheinen und 5.000+ Artikel enthalten.

Ich habe versucht, die Lösung dafür auf Stack Overflow zu finden (https://stackoverflow.com/questions/45729617/conditionally-duplicating-rows-in-excel), die Frage war nur zu vage formuliert, um wirklich gute Resultate zu generieren. Da ich selber zwar firm in PHP bin, von VBA aber exakt gar keine Ahnung habe, ist meine „Weiterentwicklung“ des Codes wohl das schlimmste Progrämmchen, was ich je geschrieben habe 😉 Egal, bis auf Kleinigkeiten funktioniert es, wenn man entsprechende Vorarbeit leistet.

Folgende Spalten MUSS die Tabelle in genau dieser Reihenfolge haben:
| HAN/MPN | Artikelname | Variation (zB Größe) | Leer | EAN/UPC |

Spalten hinter EAN (zB HEK, UVP, Gewicht o.ä.) werden so wie vom Lieferanten bereitgestellt mitkopiert. Der Vaterartikel hat keine EAN, keine VaterID und keine Variation, diese werden durch das Script entsprechend gelöscht. Die Artikelnummern werden in der Form 1234 (Vater) und 1234.Varwert (Kind) angelegt, Kinder erhalten die 1234 als VaterID.

Das Resultat sieht von den Spalten her so aus:
| Variation SortNr | HAN/MPN | | HAN/MPN | Hilfsspalte | Variationswert | Artikelnummer | VaterID | Artikelname | EAN/UPC |
… allerdings ohne Header, diese müssen manuell eingetragen oder in der Ameise gemappt werden.

Sub ConditionallyDuplicateRows()

'MPN | Name | Size | None | EAN

Dim lRw As Long
Dim artNr As Long
Dim artOffset As Long
Dim artPrefix As String
Dim varPrefix As String
Dim year As String

Application.ScreenUpdating = False

'Set ID Offset
artOffset = 104700
artNr = artOffset
artPrefix = "ART"
varPrefix = " Größe "
year = ""

Range("B1").EntireColumn.Insert
Range("A1").EntireColumn.Insert
Range("F1").EntireColumn.Insert
Range("G1").EntireColumn.Insert

lRw = Range("B" & Rows.Count).End(xlUp).Row - 1

For i = lRw To 1 Step -1
    If Range("B" & i).Value <> Range("B" & i + 1).Value Then
    
       'PARENT
    
       'Copy Last Rows Data Into New Parent Row
       Rows(i + 1).Copy
       Range("A" & i + 1).Insert Shift:=xlDown
       
       'Highlight Parent Row
       Cells(i + 1, 1).EntireRow.Interior.Color = vbYellow
       
       'Set ID and Parent ID
       artNr = artNr + 1
       Range("F" & i).Value = artPrefix & artNr & "." & Range("E" & i).Value 'ID
       Range("F" & i + 1).Value = artPrefix & artNr - 1 'ID Field for Parent
       Range("G" & i).Value = artPrefix & artNr 'Parent ID
       Range("H" & i + 1).Value = Range("B" & i + 2).Offset(, 2).Value & year
       Range("H" & i).Value = Range("D" & i).Value & year & varPrefix & Range("E" & i)
       'Use as VarSort
       Range("A" & i).Value = i
       
       'Delete VarSort, Parent ID, Variation and EAN
       Range("A" & i + 1).Value = "" 'VarSort
       Range("E" & i + 1).Value = "" 'Variation
       Range("G" & i + 1).Value = "" 'Parent ID
       Range("I" & i + 1).Value = "" 'EAN
       
       'DONT Delete Old Code!
       Range("B" & i).Offset(1, 1).Value = Range("B" & i + 2).Value
       Range("B" & i).Offset(1, 2).Value = Range("B" & i + 2).Offset(, 2).Value
       Range("B" & i).Offset(2, 1).Value = Range("B" & i).Offset(2).Value
       
    Else
        
        'CHILD
        
        Range("F" & i).Value = artPrefix & artNr & "." & Range("E" & i).Value 'ID
        Range("G" & i).Value = artPrefix & artNr 'Parent ID
        Range("H" & i).Value = Range("D" & i).Value & year & varPrefix & Range("E" & i) 'Childs Name
        
        Range("A" & i).Value = i
        
        'DONT Delete Old Code!
        Range("B" & i).Offset(1, 1).Value = Range("B" & i + 1).Value
        
    End If
Next i

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Bekannte Fehler:

1. die letzte Zeile wird nicht vernünftig befüllt, muss händisch gemacht werden
2. Das Script vergleicht nur HAN, keine Artikelnamen. Daher werden Artikel, die zwei Variationen (zB Größe und Farbe) haben, nicht korrekt kopiert. Lösung: je nach Präferenz HAN und zB Farbe verketten (6789-rot).
3. Und ich bekomme den alten Code nicht weg, ohne das Script zu töten 😉

Auf jeden Fall wäre das hier ein erster Ansatz, ein solches VBA Script zu benutzen. Mir hilft es schon sehr gut, aber Potential nach oben wäre da 😀

Verbesserungsvorschläge gerne am Ende des Beitrags als Kommentar posten! Vielleicht findet sich hier ja ein begnadeter VBA Programmierer 🙂