Макрос для текста в столбец с последующим транспонированием преобразованного текста в столбцы и вставкой строк

Question

У меня есть лист Excel с тремя столбцами SKU, заголовок и размер, как показано здесь:

После запуска макроса мне нужно, чтобы лист выглядел так:

Я застрял при добавлении строк, чтобы сопоставить преобразованный текст в столбце.

Answer 1

Как это работает?

Sub splitBySize()
Dim lastRow As Long, i As Long, k As Long
Dim sizes() As String

lastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = lastRow To 2 Step -1
    sizes = Split(Cells(i, 3), ", ") 'Add sizes to an array
    If UBound(sizes) <> 0 Then ' If there's more than one size, then...
        Range(Cells(i + 1, 1), Cells(i + UBound(sizes), 1)).EntireRow.Insert
        For k = LBound(sizes) To UBound(sizes) ' This will add the sizes to the new cells inserted
            Cells(i, 3).Offset(k, 0).Value = sizes(k)
        Next k
    End If
Next i

End Sub

По сути, он просто просматривает каждую строку, помещает размеры в массив, добавляет строки между ними, а затем заполняет ячейки размерами.

Answer 2

Попробуйте это, но измените имена листов (т.е. Sheet1 and Sheet2) на листы в вашей рабочей книге . Обратите внимание, что Sheet2 - это пустой лист, в котором будет сохранен желаемый результат.

Option Explicit

Dim wshI As Worksheet
Dim wshO As Worksheet
Dim i As Integer
Dim j As Integer
Dim r As Integer

Sub delimited()

Set wshI = Worksheets("Sheet1") 'change this to the sheet that has your data
Set wshO = Worksheets("Sheet2") 'make a new sheet and change this to its name

'This extract each size to a column (text to columns)
    wshI.Activate
 'Change "100" to the last column of your data
  wshI.Range("C2:C100").TextToColumns Destination:=Range("C2"), DataType:=xlDelimited, _
  TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
  Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
  :=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2)), TrailingMinusNumbers:= _
        True

i = 1
j = 3
r = 1
'This put the desired outcome into the sheet2
While wshI.Cells(i, 1) <> ""
    Do While wshI.Cells(i, j) <> ""
        If j = 3 Then
            wshO.Cells(r, 1) = wshI.Cells(i, 1)
            wshO.Cells(r, 2) = wshI.Cells(i, 2)
            wshO.Cells(r, 3) = wshI.Cells(i, 3)
        Else
            wshO.Cells(r, 3) = wshI.Cells(i, j)
        End If
        j = j + 1
        r = r + 1
    Loop
    j = 3
    i = i + 1
Wend

i = 2
j = 4

'This put the data into its original format
While wshI.Cells(i, 1) <> ""
    Do While wshI.Cells(i, j) <> ""
        wshI.Cells(i, 3) = wshI.Cells(i, 3) & ", " & wshI.Cells(i, j)
        wshI.Cells(i, j).Clear
        j = j + 1
    Loop
j = 4
i = i + 1
Wend

End Sub

Answer 3

Вы можете использовать Данные ► Получить и преобразовать ► Из таблицы

• Разбить столбец Размер на запятую или запятую + пробел
• Выберите SKU и заголовки столбцов
• Разверните "другие" столбцы
• Удалить третий столбец; и переименуйте новый третий столбец "Размер"
• Сохранить запрос
• Используйте условное форматирование, чтобы исключить соответствующие записи в столбцах A и B
  • Формула CF была бы `= AND($ A2 <> $ A1, $ B2 <> $ B1)
  • Пользовательский формат чисел будет ;;;