Question

我有一个查询数据源并返回大约230行逗号分隔结果的数组的电子表格。数据如下所示：

Existing Data

我需要将现在位于一个单元格（B列）中的所有逗号分隔值拆分为单独的单元格。每行通常有21个结果。所以结果应该是这样的：

Desired Result

数据开始的行可能会有所不同，但通常从第80行开始。顶行用于显示其下方数据的结果。起点可以修改为第120行（如果这样可以使脚本更容易），这将为将来的开发留下足够的空间。

我尝试修改了我在这里找到的一些不同的解决方案，但都没有奏效。任何帮助都非常感激！

Answer 1

您应该能够使用Excel的文本到列功能解释at this link来执行您想要的操作。您只需单击一下即可重写单个行或其中的大块。我特别提请您注意第三个选项卡上的参数，您可以在其中定义数据的目标，例如您提到的B120。

Answer 2

我没有完全测试这个，但也许你可以试试这样的东西。该过程应遍历行并拆分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

我的表单看起来像这样。

在运行程序后，它看起来像这样。

Answer 3

感谢大家的帮助并指出了正确的方向。以下是我最终使用的内容：

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列中，然后向后填充。我可能需要将其作为一个单独的问题进行搜索。

再次感谢您的帮助！

Answer 4

我建议采用一种非常简单的方法。

剪切所有逗号分隔数据并将其粘贴到txt文件中。在你的情况下，它应该从B列（第120行或其他任何东西）
在数据标签中，点击＆＃34;来自文字＆＃34;并打开您的文本文件
选择以逗号分隔的选项分隔，然后点击下一步
单击完成后，Excel会询问必须粘贴数据的单元格。提供您想要数据的所需单元名称。在你的情况下，它可以是B120。

现在你得到了你想要的东西。如果您意外损坏数据，最好备份工作表

我需要将一组数据拆分为excel中的单元格

4 个答案: