如何将字符串拆分为多个单元格的单元格？

Question

我希望我的代码通过一个包含名称的单元格列表，然后将它们拆分为原始单元格旁边的单元格。 我有一些基本的代码来做第一位，但是我很难让它在我的列表的其余部分循环，并且还将它输出到原始而不是A1当前的A1。 我认为这是代码中“Cell”部分的一个问题，但我无法解决它。

Sub NameSplit()

    Dim txt As String
    Dim i As Integer
    Dim FullName As Variant
    Dim x As String, cell As Range

    txt = ActiveCell.Value

    FullName = Split(txt, " ")

    For i = 0 To UBound(FullName)

        Cells(1, i + 1).Value = FullName(i)

    Next i


End Sub

Answer 1

在名称值范围上使用For Each循环。 在这种情况下，我只是假设他们在第一列，但你可以相应地调整：

Sub NameSplit()

Dim txt As String
Dim i As Integer
Dim FullName As Variant
Dim x As String, cell As Range

For Each cell In ActiveSheet.Range(Cells(1,1),Cells(ActiveSheet.UsedRange.Count,1))
     txt = cell.Value

     FullName = Split(txt, " ")

     For i = 0 To UBound(FullName)

         cell.offset(0,i + 1).Value = FullName(i)

     Next i

Next cell

End Sub

Answer 2

确保您没有尝试拆分空白单元格并立即写入所有值，而不是嵌套第二个For ... Next语句 。

Sub NameSplit()
    Dim var As Variant
    Dim rw As Long

    With Worksheets("Sheet1")   '<~~ you should know what worksheet you are on!!!!
        'from row 2 to the last row in column A
        For rw = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            'check to make the cell is not blank
            If CBool(Len(.Cells(rw, "A").Value2)) Then
                'split on a space (e.g. Chr(32))
                var = Split(.Cells(rw, "A").Value2, Chr(32))
                'resize the target and stuff the pieces in
                .Cells(rw, "B").Resize(1, UBound(var) + 1) = var
            End If
        Next rw
    End With
End Sub

如果您只是在空格上拆分，您是否考虑过Range.TextToColumns方法 ？

Sub NameSplit2()
    Dim var As Variant
    Dim rw As Long

    'disable overwrite warning
    Application.DisplayAlerts = False

    With Worksheets("Sheet1")   '<~~ you should know what worksheet you are on!!!!
        'from row 2 to the last row in column A
        With .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
            'Text-to-Columns with space delimiter
            .TextToColumns Destination:=.Cells(1, 2), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
                    Tab:=False, Semicolon:=False, Comma:=False, Other:=False, _
                    Space:=True
        End With
    End With

    Application.DisplayAlerts = True

End Sub

Answer 3

一种方法是将do循环与for循环组合 。

当你一开始不确定有多少项时，循环是迭代项目的好方法。 在这种情况下，一次执行期间的名称可能比下一次更多。

当你事先知道要循环的项目数量时，for循环很方便。 在这种情况下，我们在循环的开始就知道我们的名字数组中有多少个元素。

下面的代码从活动单元格开始，向下运行，直到找到一个空单元格。

Sub SplitName()
' Splits names into columns, using space as a delimitor.
' Starts from the active cell.
Dim names As Variant            ' Array.  Holds names extracted from active cell.
Dim c As Integer                ' Counter.  Used to loop over returned names.

    ' Keeps going until the active cell is empty.
    Do Until ActiveCell.Value = vbNullString

        names = Split(ActiveCell.Value, Space(1))

        ' Write each found name part into a seperate column.
        For c = LBound(names) To UBound(names)

            ' Extract element to an offset of active cell.
            ActiveCell.Offset(0, c + 1).Value = names(c)
        Next

        ActiveCell.Offset(1, 0).Select  ' Move to next row.
        DoEvents                        ' Prevents Excel from appearing frozen when running over a large number of items.
    Loop
End Sub

有几种方法可以改善这一过程。

作为一般规则，当它避免像ActiveCell这样的对象时，自动化会更加健壮。 这是因为用户可以在代码执行时移动活动单元格。 您可以重构此过程以接受源范围作为参数。 然后，您可以构建另一个子计算源范围并将其传递给此子进行处理。 这将提高SplitName的可重用性。

您还可以查看Excels Text to Columns方法。 这可能会使用更少的代码行产生所需的结果，这总是好的。

Answer 4

如果可以的话，文本到列将是一个很好的方法。 如果不是这里是使用数组和字典的方法。 这样做的好处是所有单元都可以一次读取，然后在写回结果之前在内存中进行操作。

Sub SplitCells()
    Dim i As Long
    Dim temp() As Variant
    Dim dict As Variant

    ' Create a dictionary
    Set dict = CreateObject("scripting.dictionary")

    ' set temp array to values to loop through
    With Sheet1
        'Declare your range to loop through
        temp = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    End With

    ' Split the values in the array and add to dictionary
    For i = LBound(temp) To UBound(temp)
        dict.Add i, Split(temp(i, 1), " ")
    Next i

    ' Print dictionary results
    With Sheet1.Cells(1, 2)
        For Each Key In dict.keys
            .Range(.Offset(Key - 1, 0), .Offset(Key - 1, UBound(dict.Item(Key)))) = dict.Item(Key)
        Next Key
    End With
End Sub

输出：