エクセルマクロヘルプ - 私はExcelで2つの列を持っている

Question

によってグループ：あなたが役立つかもしれない、次のVBAソリューションで大丈夫であれば

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

として出力する必要があります。

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 Editorが開き、 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