我需要將Excel數據分割成單元格

我有一個電子表格查詢數據源，並返回一個由230行逗號分隔的結果組成的數組。數據看起來像這樣：我需要將Excel數據分割成單元格

Existing Data

我需要有所有這些逗號隔開的現在是在一個單元（列B）分割成單獨的單元的值。每行通常有21個結果。所以結果應該是這樣的：

Desired Result

上可以改變數據開始行，但通常開始各地的頂級行用於從它下面的數據顯示結果80排。起點可以固定在120行（如果這使得腳本更容易），這將爲未來的開發留下充足的空間。

我試着修改了我在這裏找到的一些不同的解決方案，但都沒有工作。任何幫助都非常感謝！

來源

2017-04-01 Steve

將逗號分隔的數據複製到記事本中，並使用find和replace將所有逗號替換爲TAB。將其複製並粘貼回Excel，然後將這些值放入單獨的單元格中。 – Gordon

只需使用「數據」>「文本到列」並在逗號分隔。無需將數據導出到記事本等。如果您希望vba解決方案遍歷需要拆分的單元格並使用「拆分」功能並將該數組寫回到工作表 – Tom

將'0,0'放入A1在空白工作表上，並通過TextToColumns，分隔符，逗號，完成。清除A1和B1。將來自其源的數據粘貼到A1中。它應該正確拆分。 – Jeeped

感謝所有幫助和指引正確的方向。這是我最終使用的：

Sub Expand_Array_On_New_Sheet 

' First check that new sheet name doesn't already exist, and create sheet 

    Sheet_name_to_create = Sheet10.Range("B1").Value 
    If WorksheetExists2(Sheet10.Range("B1")) Then 
     MsgBox "Sheet name already exists" 
    Exit Sub 
    Else 
    Sheets.Add After:=Sheets(1) 
    ActiveSheet.Name = Sheet_name_to_create 
    End If 

' Copy array data to new sheet 

    Worksheets("Lookup").Range("A11:B250").Copy 
    Range("A101").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 
    Application.CutCopyMode = False 

' Expand Array Data into Columns and do some formatting 

    Range("B101:B350").Select 
    Selection.TextToColumns Destination:=Range("C101"), DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
     Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar _ 
     :=",", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1)), TrailingMinusNumbers:=True 
    Range("C100").Select 
    ActiveCell.FormulaR1C1 = "=R[-98]C[-1]-19" 
    Range("D100").Select 
    ActiveCell.FormulaR1C1 = "=RC[-1]+1" 
    Range("D100").Select 
    Selection.AutoFill Destination:=Range("D100:V100"), Type:=xlFillDefault 
    Range("W100").Select 
    ActiveCell.FormulaR1C1 = "Current" 
    Range("C100:W100").Select 
    With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorDark1 
     .TintAndShade = -0.149998474074526 
     .PatternTintAndShade = 0 
    End With 
    Selection.Font.Bold = True 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlMedium 
    End With 
    Selection.Borders(xlEdgeRight).LineStyle = xlNone 
    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Range("B1").Select 
End Sub

它似乎運作良好。我遇到的問題是，如果數據集少於21個條目（大多數是21個，但不是全部），則最後一列數據結束於T或V列或某處。我需要最後一個條目始終在W列，並向後填充。我可能需要將它作爲一個單獨的問題進行搜索。

再次感謝您的幫助！

來源

2017-04-02 07:11:31 Steve

我沒有完全測試這個，但也許你可以嘗試這樣的事情。該過程應循環遍歷行並拆分B列中的值。

您需要將Set ws = ActiveWorkbook.Worksheets("Sheet1")中的「Sheet1」的名稱更改爲您正在使用的工作表的名稱。

Public Sub SplitData() 

    Dim ws As Worksheet 
    Set ws = ActiveWorkbook.Worksheets("Sheet1") 

    Dim row As Integer 
    For row = 1 To ws.Range("A" & ws.Rows.Count).End(xlUp).row 

     Dim split_array() As String 
     split_array = Split(ws.Range("B" & row).Value, ",") 
     Dim split_str As Variant 
     Dim col As Integer 
     col = 3 
     For Each split_str In split_array 
      ws.Cells(row, col).Value = split_str 
      col = col + 1 
     Next split_str 

    Next row 

End Sub

我的紙張開始看起來像這樣。