Excel VBA - 逗号分隔的单元格到行

Question

寻找 VBA 代码以将包含一列逗号分隔值的动态表转换为没有逗号分隔值的表。列有标题，命名范围可用于标识表和列。在“给定数据”中可以有任意数量的这些值的行。所以在这个例子中有 4 行数据，但实际上数据可以从 1 行到 300 多行数据。

给定数据（“Sheet1”）：

A                   B       C      D
CPN:                MPN:    Price: Text:
CPN1, CPN2, CPN3    MPN1    1.25   Example1
CPN4, CPN6          MPN5    3.50   Example2
CPN7                MPN4    4.20   Example3
CPN8, CPN9          MPN2    2.34   Example4

我需要的结果是另一个工作表上的表格，让我们说“Sheet2”，“A”中每个逗号分隔值的行与原始工作表中的相应数据，而不删除第一张工作表中的数据。

需要的结果（“Sheet2”）：

A     B     C      D
CPN:  MPN:  Price: Text:
CPN1  MPN1  1.25   Example1
CPN2  MPN1  1.25   Example1
CPN3  MPN1  1.25   Example1
CPN4  MPN5  3.50   Example2
CPN6  MPN5  3.50   Example2
CPN7  MPN4  4.20   Example3
CPN8  MPN2  2.34   Example4
CPN9  MPN2  2.34   Example4

我曾尝试从Here修改下面的代码，但无法让它处理我的值类型。任何帮助将不胜感激。

Private Type data
   col1 As Integer
   col2 As String
   col3 As String
End Type

Sub SplitAndCopy()

   Dim x%, y%, c%
   Dim arrData() As data
   Dim splitCol() As String

   ReDim arrData(1 To Cells(1, 1).End(xlDown))

   x = 1: y = 1: c = 1

   Do Until Cells(x, 1) = ""
       arrData(x).col1 = Cells(x, 1)
       arrData(x).col2 = Cells(x, 2)
       arrData(x).col3 = Cells(x, 3)

       x = x + 1
    Loop

    [a:d].Clear

    For x = 1 To UBound(arrData)

        Cells(c, 2) = arrData(x).col2
        splitCol = Split(Mid(arrData(x).col3, 2, Len(arrData(x).col3) - 2), ",")

        ' sort splitCol

        For y = 0 To UBound(splitCol)
            Cells(c, 1) = arrData(x).col1
            Cells(c, 3) = splitCol(y)
            c = c + 1
        Next y

    Next x

End Sub

Answer 1

Public Sub textToColumns()

Set ARange = Range("A:A")
Set BRange = Range("B:B")
Set CRange = Range("C:C")
Set DRange = Range("D:D")

Dim arr() As String

lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Set out = Worksheets.Add
out.Name = "out"
outRow = 2

For i = 2 To lr
    arr = Split(ARange(i), ",")
    For j = 0 To UBound(arr)
        out.Cells(outRow, 1) = Trim(arr(j))
        out.Cells(outRow, 2) = BRange(i)
        out.Cells(outRow, 3) = CRange(i)
        out.Cells(outRow, 4) = DRange(i)
        outRow = outRow + 1
    Next j
Next i

End Sub

我没有做标题或正确处理输出表，但您基本上可以看到发生了什么。