VBA代码来分割单元格范围内的数据

我已经编辑这个问题来添加我已经有的代码。

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

拆分规则：1-当你find一个空格“”拆分并放到下一列，然后2-循环到下一行，并执行相同的操作，直到单元格为空，即没有更多的数据。

请参阅附件中的图片 – 例如，要在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

下面是我将如何处理这个问题，尽pipe@Darren Bartrup-Cook的解决scheme似乎更直接

 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 

更新：另一个可能性是使用我的方法，以dynamic获得使用范围（几个修改），然后用Darren的方法replace我的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 

Answer 2

macroslogging使用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 

用您select的范围replaceSelection ，并删除一些默认值为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 3

我刚刚做了一个快速和肮脏的例子。 它只是匹配你的例子，必须扩展到匹配几个案例。

 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