vba - 从excel中的名称列表中生成所有组合

Question

所以我已经有了排列列表，但我想将其转换为组合。所以我有一个名称列表“约翰”“迈克”“汤姆”，这些已经转换为两列排列“约翰迈克”“约翰汤姆”“迈克约翰”“迈克汤姆”“汤姆约翰”“汤姆迈克”，那么我将如何删除冗余排列以将其转换为组合，或者创建一个新宏来生成组合更容易？

所以要清楚，我正在寻找的新名单是“约翰迈克”“约翰汤姆”“汤姆迈克”

这是昨天给我的排列宏(source)。

Sub Permutation()

Dim NameList As Variant, NameVal As Variant, NameVal2 As Variant
Dim Iter As Long

NameList = Sheet3.Range("A1:A108").Value

Iter = 1
For Each NameVal In NameList
    For Each NameVal2 In NameList
        If NameVal2 <> NameVal Then
            Range("C" & Iter).Value = NameVal
            Range("D" & Iter).Value = NameVal2
            Iter = Iter + 1
        End If
    Next NameVal2
Next NameVal

End Sub

Answer 1

尝试这个:

Sub NoRepetition()

Dim NameList As Variant, NameVal As Variant, NameVal2 As Variant
Dim Iter As Long, OutputList As Range, NotYet As Boolean

NameList = Range("A1:A5").Value

Iter = 1
For Each NameVal In NameList
    For Each NameVal2 In NameList
        LRow = Range("C" & Rows.Count).End(xlUp).Row
        Set OutputList = Range("C1:C" & LRow)
        NotYet = (Application.CountIf(OutputList, NameVal2) = 0)
        If NameVal2 <> NameVal And NotYet Then
            Range("C" & Iter).Value = NameVal
            Range("D" & Iter).Value = NameVal2
            Iter = Iter + 1
        End If
    Next NameVal2
Next NameVal

End Sub

附加概念很简单:只需添加一个检查以查看名称是否已存在于第一列中。如果是这样，请跳过该组合。如果没有，请放入。

截图:



让我们知道这是否有帮助。