excel - 在 Excel 中使用 VBA 将分隔字符串拆分并替换为新行

Question

我有两列数据。 B 列中的数据以逗号分隔。我需要每个实例都出现在新行上，同时保留 A 列中的原始 ID。我还需要 3 列中的数据，因此名称位于 B 中，编号位于 C 中。它显示如下:

<小时/>

A--------B

1--------Sam Jones, 1 hours, Chris Bacon, 2 hours
2--------John Jacob, 3 hours
3--------John Hancock, 4 hours, Brian Smith, .5 hours

<小时/>

我可以使用下面的代码来获取它:

A--------B

1--------Sam Jones, 1
1--------Chris Bacon, 2 hours
2--------John Jacob, 3 hours
3--------John Hancock, 4
3--------Brian Smith, .5 hours

<小时/>

我需要它是:(注意字符串中的最后一个值在添加到新行时也删除了小时数)

A---------B------------------------C
1---------Sam Jones-----------1
1---------Chris Bacon----------2
2---------John Jacob-----------3
3---------John Hancock-------4
3---------Brian Smith----------.5

我启动了以下代码:(我无法删除每个分隔字符串中最后一个人的“小时”，并且无法将其分成 3 列)

Sub splitByColB()  
  Dim r As Range, i As Long, ar  
  Set r = Worksheets("Sheet1").Range("B2").End(xlDown)  
  Do While r.Row > 1  
    ar = Split(r.Value, " hours, ")  
    If UBound(ar) >= 0 Then r.Value = ar(0)  
    For i = UBound(ar) To 1 Step -1  
      r.EntireRow.Copy  
      r.Offset(1).EntireRow.Insert  
      r.Offset(1).Value = ar(i)  
    Next  
    Set r = r.Offset(-1)  
  Loop  
End Sub  

Answer 1

您正在寻找这样的东西:

Sub tgr()

    Dim ws As Worksheet
    Dim aData As Variant
    Dim aTemp As Variant
    Dim aResults(1 To 65000, 1 To 3) As Variant
    Dim ResultIndex As Long
    Dim i As Long, j As Long

    Set ws = ActiveWorkbook.Sheets("Sheet1")

    With ws.Range("B2", ws.Cells(ws.Rows.Count, "B").End(xlUp))
        If .Row < 2 Then Exit Sub   'No data
        aData = .Offset(, -1).Resize(, 2).Value
    End With

    For i = LBound(aData, 1) To UBound(aData, 1)
        If Len(Trim(aData(i, 2))) = 0 Then
            ResultIndex = ResultIndex + 1
            aResults(ResultIndex, 1) = aData(i, 1)
        Else
            aTemp = Split(aData(i, 2), ",")
            For j = LBound(aTemp) To UBound(aTemp) Step 2
                ResultIndex = ResultIndex + 1
                aResults(ResultIndex, 1) = aData(i, 1)
                aResults(ResultIndex, 2) = Trim(aTemp(j))
                aResults(ResultIndex, 3) = Trim(Replace(aTemp(j + 1), "hours", vbNullString, , , vbTextCompare))
            Next j
        End If
    Next i

    ws.Range("A2").Resize(ResultIndex, UBound(aResults, 2)).Value = aResults

End Sub