如何將字符串拆分爲多個單元格的單元格？

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

一種方法是將一個do loop與for loop結合起來。

做循環是迭代項目的好方法，當你不確定一開始有多少項目時。在這種情況下，在一次執行中可能會有比下一次更多的名稱。

當您事先知道您將循環使用多少物品時，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 3

確保您沒有試圖Split空白單元格並立即寫入所有值，而不是嵌套第二個For ... Next Statement。

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 method？

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 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 

輸出：