Excel VBA创build每个可能的组合(不重复)

我需要帮助下面的Excel和什么看起来像一个VBA问题。

这里的想法是在每个分组中生成所有可能的组合(不重复)。

INPUT

COLUMN A | COLUMN B A | 1 X | 1 D | 1 C | 2 E | 2 

OUTPUT

 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 

见下文。 请注意,您需要在工具>>参考中添加参考Microsoft脚本运行时 。 将范围(“A1:A5”)更改为dynamic命名范围或静态范围,例程将为您处理其余部分。 它显示以G1开始的结果,但也可以将此/使dynamic变化为与数据范围的偏移。 由你决定。

 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