如何将string拆分为多个单元格的单元格？

我想让我的代码遍历包含名称的单元格列表，并将它们拆分为原始单元格旁边的单元格。 我有一些基本的代码做第一位，但我努力让它循环通过我的列表的其余部分，并输出它旁边的原件，而不是在A1，因为它目前。 我认为这是代码的“单元”部分的问题，但我无法完全解决这个问题。

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 (eg 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循环组合在一起。

做循环是迭代项目的好方法，当你不确定一开始就有多less项目。 在这种情况下，在一次执行中你可能会有更多的名字。

当你事先知道有多less物品会循环时，For循环很方便。 在这种情况下，我们知道在循环的开始有多less元素在我们的名字数组中。

下面的代码以活动单元格开始并向下，直到find一个空单元格。

 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这样的对象时更加健壮。 这是因为用户可以在代码执行时移动活动单元格。 您可以重构此过程以接受源范围作为参数。 然后，您可以build立另一个子计算源范围，并将其传递给该子进行处理。 这将改善SplitName的可重用性。

你也可以看看Excels Text to Columns方法。 这可能会使用更less的代码行来产生预期的结果，这总是很好的。

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 

输出：