Question

我的Excel中有两列：

TableName   Function
   100        abc
   100        def
   100        xyz
   100        ghy
   100        ajh
   101        ahd
   101        lkj
   101        gtr
   102        afg
   102        vbg
   102        arw
   102       fgtr

我需要输出

TableName     Function
    100     abc,def,xyz,ghy,ajh,
    101     ahd,lkj,gtr,
    102     102,102,102,102,

Answer 1

如果您对VBA解决方案没问题，那么以下内容可能有所帮助。

Sub Demo()
    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long
    Dim dic As Variant, arr As Variant, temp As Variant

    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Sheets("Sheet4")  'change Sheet4 to your data sheet

    With ws
        lastRow = Cells(Rows.count, "A").End(xlUp).row  'get last row with data in Column A
        Set rng = .Range("A2:B" & lastRow)              'set the range of data
        Set dic = CreateObject("Scripting.Dictionary")
        arr = rng.Value
        For i = 1 To UBound(arr, 1)
            temp = arr(i, 1)
            If dic.Exists(temp) Then
                dic(arr(i, 1)) = dic(arr(i, 1)) & ", " & arr(i, 2)
            Else
                dic(arr(i, 1)) = arr(i, 2)
            End If
        Next
        .Range("D1") = "Table Name"         'display headers
        .Range("E1") = "Function"
        .Range("D2").Resize(dic.count, 1) = Application.WorksheetFunction.Transpose(dic.keys) 'display table names
        .Range("E2").Resize(dic.count, 1) = Application.WorksheetFunction.Transpose(dic.items) 'display funtions
    End With
    Application.ScreenUpdating = True
End Sub

结果如下图所示。

要添加此代码，请从excel按 Alt + F11 。这将打开Microsoft Visual Basic编辑器，然后单击Insert＆gt; Module并粘贴上面的代码。按 F5 执行代码。

Answer 2

你可以试试这个更简单的代码，

Sub joinStr()
Dim i As Long, str As String, k As Long
Columns("A:B").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlYes
str = Cells(2, 2)
k = 2
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 1) = Cells(i + 1, 1) Then
        str = str & "," & Cells(i + 1, 2)
    Else
        Cells(k, 4) = Cells(i, 1)
        Cells(k, 5) = str
        k = k + 1
        str = Cells(i + 1, 2)
    End If
Next i
End Sub

Excel宏帮助 - 分组依据

2 个答案: