Excel 将单个单元格中的字符串划分为多个单元格

我需要将数据拆分为各个点。我的宏以散点图的形式绘制数据：a列作为图表标题，B列作为X轴，C列和D列作为Y轴。我需要的是，当产品ID列出了多个编号时，将这些编号拆分为各自的行，并使从原始ID创建的每一行的B、C和D列保持相同。所以对于第167行，我想要3行（001002003），每行分别在B、C和D中包含包装200和100。我不知道从哪里开始。我试图构建一个宏，但当我试图记录一个“查找”公式来运行数据时，我立即被绊倒了。任何帮助都将不胜感激

A列：001、002、003//B列：包装//C列：200//D列：100

很抱歉，我无法发布我的数据截图，论坛不允许我发布。如果您有任何问题，请让我知道，我一定会经常检查

---

提前感谢。

您将需要解析A列中的数据。我将通过将字符串拆分为一个数组来完成此操作，然后迭代数组项以在必要时添加/插入其他行

在没有看到您的工作表的情况下，我可能会从这样的内容开始，将单元格值从列A中拆分为数组，然后您可以根据需要迭代数组中的项来操作工作表

Sub TestSplit()
Dim myString as String
Dim myArray() as String
Dim cell as Range
Dim i as Long

For each cell in Range("A2",Range("A2").End(xlDown))
    myString = cell.Value 

    myArray = Split(myString, ",")  '<-- converts the comma-delimited string in to an array
    For i = lBound(myArray) to uBound(myArray)
        If i >= 1 Then
            'Add code to manipulate your worksheet, here
        End If
    Next
Next
End Sub

subtestsplit（）
将我的字符串变暗为字符串
Dim myArray（）作为字符串
暗淡单元格作为范围
我想我会坚持多久
对于范围内的每个单元格（“A2”，范围（“A2”）。结束（xlDown））
myString=cell.Value
myArray=Split（myString，“，”）=1然后
'在此处添加操作工作表的代码
如果结束
下一个
下一个
端接头

我很快就完成了这项工作，不需要太在意效率，但这应该可以做到：

  Sub SplitUpVals()

  Dim i As Long
  Dim ValsToCopy As Range
  Dim MaxRows As Long
  Dim ValToSplit() As String
  Dim CurrentVal As Variant


     MaxRows = Range("A1").End(xlDown).Row

     For i = 1 To 10000000

        ValToSplit = Split(Cells(i, 1).Value, ",")
        Set ValsToCopy = Range("B" & i & ":D" & i)

        For Each CurrentVal In ValToSplit

           CurrentVal = Trim(CurrentVal)
           Cells(i, 1).Value = CurrentVal
           Range("B" & i & ":D" & i).Value = ValsToCopy.Value

           Cells(i + 1, 1).EntireRow.Insert
           i = i + 1
           MaxRows = MaxRows + 1
        Next

        Cells(i, 1).EntireRow.Delete

     If i > MaxRows Then Exit For

     Next i

  End Sub

请注意，请确保数据下方的单元格中没有数据，因为它可能会被删除。

这是一个更好的解决方案（现在我有了更多的时间：）-希望这能起到作用

  Sub SplitUpVals()

  Dim AllVals As Variant
  Dim ArrayIndex As Integer
  Dim RowLooper As Integer


   AllVals = Range("A1").CurrentRegion
   Range("A1").CurrentRegion.Clear

   RowLooper = 1

   For ArrayIndex = 1 To UBound(AllVals, 1)
      ValToSplit = Split(AllVals(ArrayIndex, 1), ",")

        For Each CurrentVal In ValToSplit

           CurrentVal = Trim(CurrentVal)
           Cells(RowLooper, 1).Value = CurrentVal
           Cells(RowLooper, 2).Value = AllVals(ArrayIndex, 2)
           Cells(RowLooper, 3).Value = AllVals(ArrayIndex, 3)
           Cells(RowLooper, 4).Value = AllVals(ArrayIndex, 4)

           RowLooper = RowLooper + 1
         Next

   Next ArrayIndex

  End Sub

'这会将任何组合到同一行的代码拆分为具有各自独立数据的单独行

Dim a, b, txt As String, e, s, x As Long, n As Long, i As Long, ii As Long
With Range("a1").CurrentRegion
    a = .Value
    txt = Join$(Application.Transpose(.Columns(1).Value))
    x = Len(txt) - Len(Replace(txt, ",", "")) + .Rows.Count
    ReDim b(1 To x * 2, 1 To UBound(a, 2))
    For i = 1 To UBound(a, 1)
        For Each e In Split(a(i, 1), ",")
            If e <> "" Then
                For Each s In Split(e, "-")
                    n = n + 1
                    For ii = 1 To UBound(a, 2)
                        b(n, ii) = a(i, ii)
                    Next
                    b(n, 1) = s
                Next
            End If
        Next
    Next
    With .Resize(n)
        .Columns(1).NumberFormat = "@"
        .Value = b
    End With
End With

将a、b、txt标注为字符串，e、s、x标注为长，n标注为长，i标注为长，ii标注为长
具有范围（“a1”）。当前区域
a=.值
txt=Join$（Application.Transpose（.Columns（1）.Value））
x=Len（txt）-Len（替换（txt，，，）+.Rows.Count
重拨b（1对x*2，1对UBound（a，2））
对于i=1到UBound（a，1）
对于拆分中的每个e（a（i，1），“，”）
如果是“e”，则
对于拆分中的每个s（e，“-”）
n=n+1
对于ii=1至UBound（a，2）
b（n，ii）=a（i，ii）
下一个
b（n，1）=s
下一个
如果结束
下一个
下一个
使用。调整大小（n）
.Columns（1）.NumberFormat=“@”
.Value=b
以
以

---

End Sub

我想你可能需要一个宏来完成这项工作，但如果你需要帮助，请不要说“我绊倒了”。请向我们展示您试图编写的内容，并解释哪里出了问题，我们可以帮助您找到有效的解决方案。如果你认为屏幕截图是有益的，请上传到imgur并发布一个链接，并请具有较高代表性的人为你在线编辑。将屏幕上传到任何互联网站点并在此处删除一个链接即可。这非常有效，它完全符合我的要求，只有一个例外。当列A中的字符串在各行之间相同时，它将仅在其他每一个实例上工作（即，如果列A在第2、3、4、5行中有001002，它将仅在第2和第4行工作）。据我所知，它的工作原理相当一致，就像这样。另外，我想知道是否有可能让它既找逗号又找“-”呢？非常感谢您的帮助。您最好自己提交answer@nickJR，我发布了另一个更有效/更好的解决方案-希望它能奏效！！

Dim a, b, txt As String, e, s, x As Long, n As Long, i As Long, ii As Long
With Range("a1").CurrentRegion
    a = .Value
    txt = Join$(Application.Transpose(.Columns(1).Value))
    x = Len(txt) - Len(Replace(txt, ",", "")) + .Rows.Count
    ReDim b(1 To x * 2, 1 To UBound(a, 2))
    For i = 1 To UBound(a, 1)
        For Each e In Split(a(i, 1), ",")
            If e <> "" Then
                For Each s In Split(e, "-")
                    n = n + 1
                    For ii = 1 To UBound(a, 2)
                        b(n, ii) = a(i, ii)
                    Next
                    b(n, 1) = s
                Next
            End If
        Next
    Next
    With .Resize(n)
        .Columns(1).NumberFormat = "@"
        .Value = b
    End With
End With