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

时间:2012-11-20 22:09:51

标签: excel vba excel-vba

我需要以下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

1 个答案:

答案 0 :(得分:1)

见下文。 请注意,您需要在工具>>中添加参考Microsoft Scripting Runtime。参考即可。将范围(“A1:A5”)更改为动态命名范围或静态范围,例程将为您处理其余范围。它显示从G1开始的结果,但您也可以将此/ make 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