Excel VBA創建每個可能的組合（無重複）

Question

我需要幫助以下excel和看起來像VBA問題。

這裏的想法是在每個分組中生成所有可能的組合（無重複）。

INPUT

COLUMN A | COLUMN B 

A | 1 

X | 1 

D | 1 

C | 2 

E | 2 

輸出

COLUMN A | COLUMN B 

A | X 

A | D 

X | D 

X | A 

D | A 

D | X 

C | E 

E | C 

我設法做....我如何讓它只有當數據在同一個組中運行。

Option Explicit 

Sub Sample() 

    Dim i As Long, j As Long 
    Dim CountComb As Long, lastrow As Long 

    Application.ScreenUpdating = False 

    CountComb = 0: lastrow = 1 

    For i = 1 To 10: For j = 1 To 10 

     Range("G" & lastrow).Value = Range("A" & i).Value & "/" & _ 
            Range("B" & j).Value 

     lastrow = lastrow + 1 
     CountComb = CountComb + 1 
    Next: Next 

    Application.ScreenUpdating = True 
End Sub 

Answer 1

見下文。 請注意，您需要在工具>>參考文獻中添加參考Microsoft腳本運行時。將範圍（「A1：A5」）更改爲動態命名範圍或靜態範圍，例程將爲您處理其餘部分。它顯示以G1開始的結果，但您也可以將此/使動態更改爲與數據範圍的偏移。由你決定。

Option Explicit 
Option Base 1 

Dim Data As Dictionary 

Sub GetCombinations() 

    Dim dataObj As Variant 
    Dim returnData As Variant 
    Set Data = New Dictionary 
    Dim i As Double 

    dataObj = Range("A1:B5").Value2 

    ' Group Data 
    For i = 1 To UBound(dataObj) Step 1 

     If (Data.Exists(dataObj(i, 2))) Then 
      Data(dataObj(i, 2)) = Data(dataObj(i, 2)) & "|" & dataObj(i, 1) 
     Else 
      Data.Add dataObj(i, 2), dataObj(i, 1) 
     End If 

    Next i 

    ' Extract combinations from groups 
    returnData = CalculateCombinations().Keys() 

    Range("G1").Resize(UBound(returnData) + 1, 1) = Application.WorksheetFunction.Transpose(returnData) 

End Sub 

Private Function CalculateCombinations() As Dictionary 

    Dim i As Double, j As Double 
    Dim datum As Variant, pieceInner As Variant, pieceOuter As Variant 
    Dim Combo As New Dictionary 
    Dim splitData() As String 

    For Each datum In Data.Items 

     splitData = Split(datum, "|") 
     For Each pieceOuter In splitData 
      For Each pieceInner In splitData 

       If (pieceOuter <> pieceInner) Then 

        If (Not Combo.Exists(pieceOuter & "|" & pieceInner)) Then 
         Combo.Add pieceOuter & "|" & pieceInner, vbNullString 
        End If 

       End If 

      Next pieceInner 
     Next pieceOuter 

    Next datum 

    Set CalculateCombinations = Combo 

End Function