将文本拆分为较小的文本并按每个 ID 进行分组

Question

我有一个像这样的Excel表格

---

现在从第二列开始，我想将它们分成小的子字符串并将它们分组到每个 ID 组中，就像这样

请让我知道如何以编程方式做到这一点。

由于我是 Excel 新手，我已经尝试过此操作，但它不起作用：https://support.microsoft.com/en-us/office/split-text-into- Different-columns-with-the-将文本转换为列向导-30b14928-5550-41f5-97ca-7a3e9c363ed7

Answer 1

请尝试使用下一个代码。即使对于大范围，使用数组并处理内存中的几乎所有内容，它也应该非常快。

要处理的范围应该在A:B列中，并且从D2开始返回：

Sub splitRedistribute()
  Dim sh As Worksheet, lastR As Long, arr, arrSpl, arrFin, prevStr As String
  Dim i As Long, j As Long, k As Long, dict As Object
  
  Set sh = ActiveSheet 'use here the sheet you need
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row on A:A column
  
  arr = sh.Range("A2:B" & lastR).Value2 'place the range to be processed in an array for faster processing
  
  'load the dictionary with the necessary data:
  Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary
  For i = 1 To UBound(arr) 'iterate between the array rows:
    arrSpl = Split(arr(i, 2), " > ") 'obtain an array by splitting the B:B column content
    dict(arr(i, 1)) = arrSpl         'place the array as item of A:A key
    k = k + UBound(arrSpl) + 1       'variable use to know how many rows arrFin must have
  Next i
  
  ReDim arrFin(1 To k, 1 To 2):  k = 1 'Redim the final array and reuse k variable, reinitializing it
  'process the dictionary data and load arrFin:
  For i = 0 To dict.count - 1 'iterate between the dictionary elements (key/items)
    prevStr = ""                              'renitialize the var which temp keeps the previous concatenated value
    For j = 0 To UBound(dict.Items()(i))
        arrFin(k, 1) = dict.keys()(i)         'place the key in array first column
        Select Case j                         'load the array second column according to iteration number
            Case 0
              arrFin(k, 2) = dict.Items()(i)(j) 'place the first array element
              prevStr = arrFin(k, 2): k = k + 1 'memorize the first element and increment the row var (k)
            Case Else
              arrFin(k, 2) = prevStr & " > " & dict.Items()(i)(j) 'place the concatenation in the second column
              prevStr = arrFin(k, 2): k = k + 1 'memorize the concatenated string to be used further and increment the row
        End Select
    Next j
  Next i
  
  'drop the processed array content, at once:
  sh.Range("D2").Resize(UBound(arrFin), UBound(arrFin, 2)).Value2 = arrFin
End Sub

请在测试后发送一些反馈。

我对代码进行了评论，但如果有些内容不够清楚，请随时要求澄清。

作为一般建议，您不应粘贴图片，尝试显示可编辑的内容以用于测试，并且始终欢迎显示您的尝试的一段代码。即使它不能满足您的需要...我们可以看到您尝试处理的范围、您尝试返回的位置等。