从excel中的名称列表中产生所有组合

所以我已经有了排列列表，但我想将其转换为组合。 所以我有一个名单“约翰”“迈克”“汤姆”，这些已经被转换为两列排列“约翰迈克”“约翰汤姆”“迈克约翰”“迈克汤姆”“汤姆约翰”“汤姆·迈克“，所以我怎么去删除多余的排列组合，或将更容易使一个新的macros只是生成组合？

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

这里是昨天给我的排列macros（ 来源 ）。

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 

附加的概念很简单：只需添加一个检查来查看名称是否已经存在于第一列中。 如果是，则跳过该组合。 如果没有，就把它放进去。

截图：

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