excel - 将一列拆分为多列

Question

我想知道是否有人可以建议如何将具有逗号分隔值的字符串拆分为多列。我一直试图解决这个问题，但一直很难找到一个好的解决方案。 (也在网上查过，似乎有几个接近但不一定符合我的确切需要)

假设我有一个工作表，称之为“示例”，例如，
并且在工作表中有以下多个字符串
行，但都在“A”列中。

20120112,aaa,bbb,ccc,3432 
20120113,aaa,bbb,ccc
20120113,ddd,bb,ccc,ddd,eee,fff,ggg,hhhh 
20120132,aaa,bbb,ccc
20120112,aaa,bbb,ccc 
20120112,xxx,bbb,ggg,ggg,333
20120112,aaa,bbb,ccc 
20120112,abbd,bbb,ccc

如何创建一个将上述内容拆分为多列的宏。

就几个点

(1)我应该能够指定工作表名称
例如:类似的东西

工作表(“示例”).range(A，A)'

(2) 列数和行数不固定，所以我没有
知道有多少逗号分隔值和有多少行
将在我运行 vba 脚本之前。

Answer 1

您可以使用 InputBox()函数并获取应拆分数据的工作表名称。

然后将数据复制到变量数组中，拆分它们并创建新的拆分值数组。

最后将拆分值数组分配回 excel 范围。 HTH

(注意，源数据是直接修改的，所以最后被分成列，原始未拆分状态丢失。但是可以修改代码，以免覆盖原始数据。)

Option Explicit

Private Const sourceColumnName As String = "A"
Private Const delimiter As String = ","

Public Sub Splitter()

    ' splits one column into multiple columns

    Dim sourceSheetName As String
    Dim sourceSheet As Worksheet
    Dim lastRow As Long
    Dim uboundMax As Integer
    Dim result

    On Error GoTo SplitterErr

    sourceSheetName = VBA.InputBox("Enter name of the worksheet:")

    If sourceSheetName = "" Then _
        Exit Sub

    Set sourceSheet = Worksheets(sourceSheetName)

    With sourceSheet
        lastRow = .Range(sourceColumnName & .rows.Count).End(xlUp).row
        result = SplittedValues(data:=.Range(.Cells(1, sourceColumnName), _
                                             .Cells(lastRow, sourceColumnName)), _
                                partsMaxLenght:=uboundMax)

        If Not IsEmpty(result) Then
            .Range(.Cells(1, sourceColumnName), _
                   .Cells(lastRow, uboundMax)).value = result
        End If
    End With

SplitterErr:
    If Err.Number <> 0 Then _
        MsgBox Err.Description, vbCritical
End Sub

Private Function SplittedValues( _
    data As Range, _
    ByRef partsMaxLenght As Integer) As Variant

    Dim r As Integer
    Dim parts As Variant
    Dim values As Variant
    Dim value As Variant
    Dim splitted As Variant

    If Not IsArray(data) Then
        ' data consists of one cell only
        ReDim values(1 To 1, 1 To 1)
        values(1, 1) = data.value
    Else
        values = data.value
    End If

    ReDim splitted(LBound(values) To UBound(values))

    For r = LBound(values) To UBound(values)

        value = values(r, 1)
        If IsEmpty(value) Then
            GoTo continue
        End If

        ' Split always returns zero based array so parts is zero based array
        parts = VBA.Split(value, delimiter)
        splitted(r) = parts

        If UBound(parts) + 1 > partsMaxLenght Then
            partsMaxLenght = UBound(parts) + 1
        End If

continue:
    Next r

    If partsMaxLenght = 0 Then
        Exit Function
    End If

    Dim matrix As Variant
    Dim c As Integer
    ReDim matrix(LBound(splitted) To UBound(splitted), _
                 LBound(splitted) To partsMaxLenght)

    For r = LBound(splitted) To UBound(splitted)
        parts = splitted(r)
        For c = 0 To UBound(parts)
            matrix(r, c + 1) = parts(c)
        Next c
    Next r

    SplittedValues = matrix
End Function