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”中每个逗号分隔值的行与原始表格中的相应数据不同，而不删除第一张表格中的数据。 / p>

需要的结果（“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

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

Answer 2

适应@MacroMarc答案，如果在逗号“，”之前或之后没有值，它将添加一个新条目，这将导致另外一行。因此，为避免这种情况，请在写入新行之前检查分隔的值是否为空。

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)
        If Len(Trim(arr(j))) > 0 Then
            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
        End If
    Next j
Next i

End Sub

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

2 个答案: