VBA代码在单元格范围内拆分数据

Question

我已编辑此问题以添加我已有的代码。

我需要一个VBA Excel代码来分割单元格中的数据。

拆分规则： 1-每当你找到一个空格“”拆分并将其放入下一列时，那么 2-循环到下一行并执行相同操作，直到Cell为空，即不再有数据。

请参阅附图中的例子 - 要在A栏中拆分的数据，结果将在下一栏中。

我尝试了下面的代码并且它完成了工作，但它没有循环到下一行，请编辑此代码以使其循环到下一行并在没有更多数据时停止，即空白单元格。

Sub example()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, " ")
For a = 0 To UBound(name)
Cells(1, a + 1).Value = name(a)
Next a
End Sub

非常感谢。

Answer 1

宏记录在使用TextToColumns时显示：

Selection.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

用您选择的范围替换Selection，并删除一些默认值为false的参数，您可以使用此代码分割A2:A4范围内的值。

Sub Test()

    SplitText ThisWorkbook.Worksheets("Sheet1").Range("A2:A4")

End Sub

Sub SplitText(MyRange As Range)

    MyRange.TextToColumns Destination:=MyRange.Offset(, 1), DataType:=xlDelimited, _
        TextQualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=True, _
        Space:=True

End Sub

Answer 2

我刚刚做了一个快速而又肮脏的例子。它只匹配您的示例，必须进行扩展以匹配多个案例。

Public Sub spliting()

Dim row As Integer
Set ws = Sheets("sheet1")
row = 1
Dim TestArray As Variant
With ws
    Do
        TestArray = split(CStr(.Cells(row, 1).Value))
        .Cells(row, 2) = TestArray(0)
        .Cells(row, 3) = TestArray(1)
        .Cells(row, 4) = TestArray(2)
        row = row + 1
    Loop Until row = 4
End With

End Sub

Answer 3

虽然@Darren Bartrup-Cook的解决方案似乎更直接但我会如何处理这个问题

Dim ws As Worksheet
Dim lastRow As Long
Dim data As Range, dataList As Range
Dim arrData, i

Set ws = ThisWorkbook.Worksheets("YourWorksheetName")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set dataList = ws.Range("A1").Resize(lastRow, 1)

For Each data In dataList
    arrData = Split(data.Value)
    For i = LBound(arrData) To UBound(arrData)
        ws.Cells(data.Row, i + 2).Value = arrData(i)
    Next
Next

更新：另一种可能性是使用我的方法来动态获取使用范围（通过一些修改），然后用Darren的方法替换我的For循环执行拆分。你最终会得到类似下面的内容

Sub Test()

    Dim lastRow As Long
    Dim dataList As Range

    With ThisWorkbook.Worksheets("YourWorksheetName")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set dataList = .Range("A1").Resize(lastRow, 1)
    End With

    SplitText dataList

End Sub

Sub SplitText(MyRange As Range)

    MyRange.TextToColumns Destination:=MyRange.Offset(, 1), DataType:=xlDelimited, _
        TextQualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=True, _
        Space:=True

End Sub

更新2：此版本将运行工作簿中每个工作表的代码

Sub Test()

    Dim lastRow As Long
    Dim ws as Worksheet
    Dim dataList As Range

    For Each ws In ThisWorkbook.Worksheets
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        Set dataList = ws.Range("A1").Resize(lastRow, 1)
        SplitText dataList
    Next

End Sub

Sub SplitText(MyRange As Range)

    MyRange.TextToColumns Destination:=MyRange.Offset(, 1), DataType:=xlDelimited, _
        TextQualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=True, _
        Space:=True

End Sub