Собрать столбец на новом листе

[Dan99]

Имеются данные вида как в первом столбце.
Все цыфры. В ячейке а1 может быть разное кол-во через запятую. В ячейке а2 может быть любая цыфра, знак х означает умножение на нное кол-во раз, тоже может быть разным. Ячейка а3 содержит одну цифру, может быть разной. Все цыфры положительные. Задача- получить один столбец как в примере С. Т. Е. Столбец с одной цифрой в ячейке. Цифра означает некий артикул (обозначение)
Помогите пожалуйста. Пример сделан вручную для наглядности. Потом получившийся столбец бедет преобразован в сводную таблицу, в которой будет видно сколько каких артикулов присутствовало в изначальном столбце.

[Serge_Bliznykov]

во-первых, цИфра
во-вторых, Вы путаете понятия "цифра" и "число"
в-третьих, такое можно сделать макросом на VBA. Он будет не сложный, но нужно будет парсить строчку.

[Dan99]

Спасибо Сергей за то что поправили меня. Хотел добавить что ячеек в первом столбце может быть разным. Очень жду помощи. Спасибо!

[Dan99]

Сообщение от Serge_Bliznykov

во-первых, цИфра
во-вторых, Вы путаете понятия "цифра" и "число"
в-третьих, такое можно сделать макросом на VBA. Он будет не сложный, но нужно будет парсить строчку.

В целом я понимаю как это чисто механически сделать, а вот автоматизировать знания не позволяют. Я так и делал, разбирал разбирал ячейку на строку и потом собирал в один столбец, но при объёмах это уйма времени. В программировании я не силен)

[Serge_Bliznykov]

АртикулыВСписок.zip

если что, там такой код

Option Explicit

Sub Click()
  Dim iLastRow&, iRow&, i&, j&, k&, m&, p%, s$, s2$
  Dim lineArray() As String
  
  Range("C:C").ClearContents
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
  k = 0
  For iRow = 1 To iLastRow
    s = Cells(iRow, "A").Value
    If s <> "" Then
        lineArray() = Split(s, ",")
        For i = LBound(lineArray) To UBound(lineArray)
            s2 = Trim(LCase(lineArray(i)))
            p = InStr(s2, "x")
            j = 1
            If p > 0 Then
              j = CInt(Mid(s2, p + 1))
              s2 = Trim(Left(s2, p - 1))
            End If
            For m = 1 To j
                k = k + 1
                Cells(k, "C").Value = s2
            Next
        Next i
    End If
  Next iRow
End Sub

[IgorGO]

см.вложение

Sub Transform()
  Dim v, a, c&, r&, i&, x&
  v = Range(Cells(1), Cells(Rows.Count, 1).End(xlUp)).Value: r = 1
  For i = 1 To UBound(v)
    x = InStr(v(i, 1), "х")
    If x > 0 Then
      c = Val(Right(v(i, 1), Len(v(i, 1)) - x))
      If c > 0 Then Cells(r, 3).Resize(c, 1).Value = Left(v(i, 1), x - 1)
      r = r + c
    Else
      a = Split(v(i, 1), ",")
      Cells(r, 3).Resize(UBound(a) + 1, 1).Value = WorksheetFunction.Transpose(a)
      r = r + UBound(a) + 1
    End If
  Next
End Sub

[Dan99]

Спасибо огромное! Как освобожусь, проверю, отпишусь.

[Dan99]

[QUOTE=IgorGO;1787893]см.вложение
Игорь, ваш вариант покорил кнопкой!
Но я не учел один момент, встретилась ячейка в которой была и запятая и умножение, в результате получил в ячейке два числа, сможете поправить код под такую ситуацию?
[QUOTE=Serge_Bliznykov;1787890]Вложение 97184
Сергей, в вашем варианте почему-то получилось больше ячеек с несколькими числами, хотя видно что вы рассматривали больше вариантов содержания изначальных данных.

Я лучше исходник приложу, так будет понятнее, если сделаете автоматическое удаление пустых ячеек, вообще песня. Но это я и так фильтром могу сделать.

Спасибо вам огромное, за то что откликнулись.

если что, там такой код
[CODE]Option Explicit

[nilem]

Можно тоже попробовать? )

Sub ertert()
Dim x, y(), i&, j&, k&, v, t&

With ActiveSheet
    If .FilterMode Then .ShowAllData
    x = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Value
End With
ReDim y(1 To UBound(x) * 6, 1 To 1)

For i = 1 To UBound(x)
    If Len(x(i, 1)) Then
        For Each v In Split(x(i, 1), ",")
            If InStr(v, "х") Then
                t = Split(Trim(v), "х")(0)
                For j = 1 To Split(Trim(v), "х")(1)
                    k = k + 1: y(k, 1) = t
                Next j
            Else
                k = k + 1: y(k, 1) = Trim(v)
            End If
        Next v
    End If
Next i
Columns(3).ClearContents
Range("C1").Resize(k).Value = y
End Sub

[Dan99]

[QUOTE=nilem;1787933]Можно тоже попробовать? )
Спасибо огромное! То что надо!