Создание уникальных строк SKU в Excel из отдельных строк

Question

У меня есть много строк данных в Excel, каждая из которых соответствует продукту. Так, например, мой первый ряд - "Черное платье леди", а затем в другой ячейке, размеры которого разделены запятыми, а также цвета в одной ячейке.

Title           Size          Colour                 Price Before  Price After
Ladies Dress    S,M,L,XL,XXL  Blue, Black, Red       19.99          29.99
Men's Trousers  S,M,L,XL,XXL  Brown, Yellow, Orange  39.99          59.99

HJ

Поэтому мне нужен VBA, который создает уникальную строку (по существу, SKU) для каждого варианта продукта, поэтому мои данные выглядят так:

Я задавал этот вопрос раньше, но только для 2-х столбцов, добрая душа предоставила этот VBA, который работает, но мне нужны другие столбцы. Я не совсем понимаю, как адаптировать этот VBA и менял букву "В" на "Е", но это, похоже, не работает.

Option Explicit

Sub sizeExpansion()
    Dim i As Long, szs As Variant

    With Worksheets("sheet1")
        For i = .Cells(.Rows.Count, "B").End(xlUp).Row To 2 Step -1
            szs = Split(.Cells(i, "B").Value2, ",")
            If CBool(UBound(szs)) Then
                .Cells(i, "A").Resize(UBound(szs), 1).EntireRow.Insert
                .Cells(i, "A").Resize(UBound(szs) + 1, 1) = .Cells(UBound(szs) + i, "A").Value2
                .Cells(i, "B").Resize(UBound(szs) + 1, 1) = Application.Transpose(szs)
            End If
        Next i
    End With

End Sub

Answer 1

Попробуйте эту модификацию с дополнительным разделенным вариантом и некоторыми математическими настройками.

Option Explicit

Sub sizeAndColorExpansion()
    Dim i As Long, s As Long, c As Long
    Dim ttl As String, pb As Double, pa As Double
    Dim szs As Variant, clr As Variant

    With Worksheets("sheet1")
        For i = .Cells(.Rows.Count, "E").End(xlUp).Row To 2 Step -1
            ttl = .Cells(i, "A").Value2
            pb = .Cells(i, "D").Value2
            pa = .Cells(i, "E").Value2
            szs = Split(.Cells(i, "B").Value2, ",")
            clr = Split(.Cells(i, "C").Value2, ",")
            If CBool(UBound(szs)) Or CBool(UBound(clr)) Then
                .Cells(i, "A").Resize((UBound(szs) + 1) * (UBound(clr) + 1) - 1, 1).EntireRow.Insert
                For s = 0 To UBound(szs)
                    For c = 0 To UBound(clr)
                        .Cells(i + (s * (UBound(clr) + 1)) + c, "A").Resize(1, 5) = _
                            Array(ttl, Trim(szs(s)), Trim(clr(c)), pb, pa)
                    Next c
                Next s
            End If
        Next i
    End With

End Sub