Excel宏幫助-分組依據

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 >“ 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