从给定列表中创建一个包含所有可能组合的表，其中包含两列（excel）

Posted 2023-03-31

【中文标题】从给定列表中创建一个包含所有可能组合的表，其中包含两列（excel）

【英文标题】：Create a table with all potential combinations from a given list with two columns (excel)

【发布时间】：2020-02-28 17:45:21

【问题描述】：

有没有办法（vba 代码或 excel 技巧）来操作 2 列式列表，以便我根据第一列中的唯一标识符获得包含所有可能组合的表？

例如我有一列带有公司名称，另一列带有国家/地区位置。如果每家公司的国家/地区组合，我需要的是每组（请参阅随附的屏幕截图）。

【问题讨论】：

只有一个国家/地区的公司（例如示例中的 APlus Science AB）应该产生什么输出？

【参考方案1】：

这个 vba 模块应该可以解决您的问题。 只需将代码复制到一个新模块，声明输入和输出列以及列表第一行的编号。 请注意，代码将在遇到“唯一标识符”单元格为空的行时停止。 此外，它要求您的列表根据您的“唯一标识符”进行排序。 如果唯一标识符只出现一次，它仍然会被写入输出列表，但只会写入一次，并且 outColNation2 在该行中保持为空。如果不希望这样做并且应该完全忽略它，只需删除注释的 if 语句。

Example Image of output

另请注意，唯一标识符最多可以重复 100 次。我认为它们中的任何一个都不会经常出现，因为这会创建一个非常长的输出列表。

Option Compare Text

Sub COMBINATIONS()

Dim i As Long, j As Long, k As Long, l As Long, n As Long
Dim arr(100) As String
Dim UI As String

Dim inColUI As Integer, inColNation As Integer
Dim outColUI As Integer, outColNation1 As Integer, outColNation2 As Integer
Dim FirstRowOfData As Integer
Dim YourWS As Worksheet

inColUI = 1  'Column of the "Unique Identifier"
inColNation = 2 'Column of the "Nations" in your example

outColUI = 4
outColNation1 = 5   'output columns
outColNation2 = 6

FirstRowOfData = 2  'First Row of data

Set YourWS = Application.Worksheets("Sheet1") 'Put in your Worksheet Name here.

i = FirstRowOfData
n = FirstRowOfData
With YourWS
    Do Until .Cells(i, inColUI) = ""
        j = 0
        UI = .Cells(i, inColUI)
        Do Until .Cells(i - 1, inColUI) <> .Cells(i, inColUI) And j > 0 Or .Cells(i, inColUI) = ""
            arr(j + 1) = .Cells(i, inColNation)
            i = i + 1
            j = j + 1
        Loop
        If j = 1 Then '<- remove this if-statement and the following marked lines if single appearing UIs should be omitted entirely
            .Cells(n, outColUI) = UI '<---
            .Cells(n, outColNation1) = arr(1) '<---
            n = n + 1 '<---
        Else '<---
            For k = 1 To j
                For l = 1 To j
                    If arr(k) <> arr(l) Then
                        .Cells(n, outColUI) = UI
                        .Cells(n, outColNation1) = arr(k)
                        .Cells(n, outColNation2) = arr(l)
                        n = n + 1
                    End If
                Next l
            Next k
        End If '<---
    Loop
End With

End Sub

编辑：稍微清理一下代码

【参考方案2】：

类似下面的内容显示了如何遍历 2 个单元格范围

Dim Rng1 as Range, Rng2 as Range
Dim SrcCell as Range, OthrCell as Range
Dim FullList as string

Rng1 = Range("A1:A12")
Rng2 = Range("B1:B12")

FullList = ""
For Each SrcCell in Rng1
   For Each OthrCell in Rng2
      FullList = IIF(FullList="","",FullList & vbCrLf) & SrcCell.Value & OthrCell.Value
   Next OthrCell
Next srcCell

FullList 字符串现在包含所有组合，但您可能需要其他内容。只是为了给你一个开始

您需要自己添加代码以过滤掉重复项

【参考方案3】：

您可以执行以下操作（请参阅下面的代码）。正如另一位评论者提到的，当公司与国家/地区只有一条记录时，它不会显示在输出中。

解决方案基于创建字典，每个条目是一个公司，值是逗号分隔的国家/地区字符串。创建字典后，循环字典，然后在嵌套循环上迭代国家列表。如果外部循环的索引与循环的内部索引相同，则跳过循环，即这将是国家 1 与国家 1 的组合。否则添加到输出列表中。

A、B 列是输入，D、E、F 列是输出。

Option Explicit

Public Sub sCombine()

  Dim r As Range, dest As Range
  Dim d As New Dictionary
  Dim key As Variant
  Dim countries() As String
  Dim i As Integer, j As Integer

  On Error GoTo error_next

  Set r = Sheet1.Range("A1")
  Set dest = Sheet1.Range("D:F")
  dest.ClearContents
  Set dest = Sheet1.Range("D1")

  While r.Value <> ""
    If d.Exists(r.Value) Then
      d(r.Value) = d(r.Value) & "," & r.Offset(0, 1)
    Else
      d.Add r.Value, r.Offset(0, 1).Value
    End If

    Set r = r.Offset(1, 0)
  Wend

  For Each key In d.Keys
    countries = Split(d(key), ",")
    For i = LBound(countries) To UBound(countries)
      For j = LBound(countries) To UBound(countries)
        If i <> j Then
          dest.Value = key
          dest.Offset(0, 1).Value = countries(i)
          dest.Offset(0, 2).Value = countries(j)
          Set dest = dest.Offset(1, 0)
        End If
      Next j
    Next i
  Next key

  Exit Sub
error_next:
  MsgBox Err.Description

End Sub

【讨论】：

注意，它需要将 Microsoft.Scripting.Runtime 添加到项目的引用中

嘿，感谢您在这里帮助我 :) 然而，由于我根本不习惯 VBA，所以我有另一个关于代码的问题。当我输入代码并运行它时，它给了我错误“未定义用户定义的类型”，引用了 scombin 子。我需要在这里添加什么来运行代码？ （抱歉我的不知道）

正如我在上面的评论中所说（老实说，我应该说得更清楚），您需要参考 Microsoft.Scripting.Runtime 库。可能代码在抱怨“字典”类型的变量。在您的 vba 编辑器中转到工具->参考->选中“Microsoft Scripting Runtime”复选框。让我知道它是否适合你

确实有效！非常感谢您的快速支持:)

没有问题，很乐意提供帮助。如果您认为它有帮助或解决了您的问题，请标记为已回答/赞成