Question

我有2列数据。 B列中的数据以逗号分隔。我需要每个实例出现在一个新行上，同时保留它在A列中的原始ID。我还需要3列中的数据，因此Name在B中，而在C中是Number。它看起来如此：

一个--------乙

1 -------- Sam Jones，1小时，Chris Bacon，2小时     2 -------- John Jacob，3个小时     3 -------- John Hancock，4小时，Brian Smith，.5小时

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

一个--------乙

1 -------- Sam Jones，1     1 -------- Chris Bacon，2小时
    2 -------- John Jacob，3个小时     3 -------- John Hancock，4
    3 -------- Brian Smith，.5小时

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

一个---------乙------------------------Ç
    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

Answer 2

You can use Power Query. It is a free MS add-in in 2010, 2013 and included in 2016 where it is called Get & Transform

Split column 2 by delimiter custom --> hours,
Select the ID column and unpivot other columns
Select column 2 and split by delimiter = comma
Remove unnecessary column
Replace value "hours"

And if you add to the table, you can re-run the query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"ID", Int64.Type}, {"Data", type text}}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Changed Type", "Data", Splitter.SplitTextByDelimiter("hours,", QuoteStyle.Csv), {"Data.1", "Data.2"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Data.1", type text}, {"Data.2", type text}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type1", {"ID"}, "Attribute", "Value"),
    #"Split Column by Delimiter1" = Table.SplitColumn(#"Unpivoted Other Columns", "Value", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"Value.1", "Value.2"}),
    #"Changed Type2" = Table.TransformColumnTypes(#"Split Column by Delimiter1",{{"Value.1", type text}, {"Value.2", type text}}),
    #"Removed Columns" = Table.RemoveColumns(#"Changed Type2",{"Attribute"}),
    #"Replaced Value" = Table.ReplaceValue(#"Removed Columns","hours","",Replacer.ReplaceText,{"Value.2"})
in
    #"Replaced Value"

Answer 3

我会使用名为data

的类

Option Explicit

Public Id As String
Public FullName As String
Public hours As String

和以下代码

Option Explicit

    Sub SplitIt()
    Dim rg As Range
    Dim col As New Collection
    Dim dataLine As data

        Set rg = Worksheets("Sheet1").Range("A1").CurrentRegion
        Dim vDat As Variant
        vDat = rg.Columns

        Dim lDat As Variant
        Dim i As Long, j As Long

        For i = LBound(vDat) To UBound(vDat)
            lDat = Split(vDat(i, 2), ",")
            For j = LBound(lDat) To UBound(lDat) Step 2
                Dim hDat As Variant
                hDat = Split(Trim(lDat(j + 1)), " ")
                Set dataLine = New data
                dataLine.Id = vDat(i, 1)
                dataLine.FullName = Trim(lDat(j))
                dataLine.hours = hDat(0)
                col.Add dataLine
            Next j
        Next i

        ' Print Out
        For i = 1 To col.Count
            Set dataLine = col(i)
            rg.Cells(i, 1) = dataLine.Id
            rg.Cells(i, 2) = dataLine.FullName
            rg.Cells(i, 3) = dataLine.hours
        Next i

    End Sub

Answer 4

为什么不将小时拆分为a）添加记录分隔符和b）摆脱小时？

Option Explicit

Sub splitByColB()
    Dim r As Long, i As Long, hrs As Variant, cms As Variant
    With Worksheets("sheet1")
        For r = .Cells(.Rows.Count, "B").End(xlUp).Row To 2 Step -1
            hrs = Split(.Cells(r, "B").Value2 & ", ", " hours, ")
            ReDim Preserve hrs(UBound(hrs) - 1)
            If CBool(UBound(hrs)) Then _
                .Cells(r, "A").Offset(1, 0).Resize(UBound(hrs), 1).EntireRow.Insert
            For i = UBound(hrs) To LBound(hrs) Step -1
                cms = Split(hrs(i), ", ")
                .Cells(r, "A").Offset(i, 0) = .Cells(r, "A").Value
                .Cells(r, "A").Offset(i, 1) = cms(0)
                .Cells(r, "A").Offset(i, 2) = cms(1)
            Next i
        Next r
    End With
End Sub

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

4 个答案: