어떻게 Excel에서 VBA를 사용하여 2 열 모두 서로 다른 독특한 조합을 얻을 세 번째

Question

이있는 How do I get all the different unique combinations of 3 columns using VBA in Excel?

에서에 따라 합계 않는 그것은 거의 내가 필요하지만, 내 요구 사항은 세 번째를 요약 한 것입니다 대신 네의 수치를 포함 칼럼 /이 코드는 원래

싯다 르트 나라 얀 롬에서 추가 된

서브없는

Sub sample() 
Dim ws As Worksheet 
Dim lRow As Long, i As Long, j As Long 
Dim col As New Collection 
Dim Itm 
Dim cField As String 

Const deLim As String = "#" 

Set ws = ThisWorkbook.Sheets("Sheet1") 

With ws 
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row 

    For i = 2 To lRow 
     cField = .Range("A" & i).Value & deLim & _ 
       .Range("B" & i).Value & deLim & _ 
       .Range("C" & i).Value 

     On Error Resume Next 
     col.Add cField, CStr(cField) 
     On Error GoTo 0 
    Next i 

    i = 2 

    .Range("A1:C1").Copy .Range("F1") 
    .Range("I1").Value = "Count" 

    For Each Itm In col 
     .Range("F" & i).Value = Split(Itm, deLim)(0) 
     .Range("G" & i).Value = Split(Itm, deLim)(1) 
     .Range("H" & i).Value = Split(Itm, deLim)(2) 


     For j = 2 To lRow 
      cField = .Range("A" & j).Value & deLim & _ 
        .Range("B" & j).Value & deLim & _ 
        .Range("C" & j).Value 

      If Itm = cField Then nCount = nCount + 1 
     Next 
     .Range("I" & i).Value = nCount 

     i = i + 1 
     nCount = 0 
    Next Itm 
End With 

종료 유타는

Answer 1

이 무엇 코드가 작성하고 SO 질문 링크에서 당신이 시도한 차이가 무엇

Option Explicit 

Sub Main() 
    Dim i As Long 
    Dim dict As Object 

    Set dict = CreateObject("Scripting.Dictionary") 
    For i = 4 To Range("A" & Rows.Count).End(xlUp).Row '<-- change 4 and "A" to your data actual upleftmost cell row and column 
     dict(cells(i, 1).Value & "|" & cells(i, 2).Value) = dict(cells(i, 1).Value & "|" & cells(i, 2).Value) + cells(i, 3).Value '<--| change 3 to your actual "column to sum up" index 
    Next 

    With Range("G3").Resize(dict.Count) '<-- change "G3" to your actual upleftmost cell to start writing output data from 
     .Value = Application.Transpose(dict.Keys) 
     .TextToColumns Destination:=.cells, DataType:=xlDelimited, Other:=True, OtherChar:="|" 
     .Offset(, 2).Resize(dict.Count).Value = Application.Transpose(dict.Items) '<--| change 2 to your actual column offset where to start writing summed values form 
    End With 
End Sub