查找列范围中存在的所有可能的字符串组合（顺序无关紧要，不允许重复）

Question

我想获取列范围内某些值的所有可能组合，并将它们打印在 Excel 工作表中：

请注意，组合顺序无关紧要，即 AB=BA

下面是第 1 列中要找到组合的数据示例：

F1
F2
F3
F4

这些可能的组合是：

F1F2
F1F3
F1F4
F2F3
F2F4
F3F4
F1F2F3
F1F2F4
F1F3F4
F2F3F4
F1F2F3F4

Answer 1

这是我的第一个 Stack Overflow 答案：

这可能不是最优雅的方法，但它确实有效。首先消除数据中的任何重复。我的倾向是为此使用 VBScript 字典——但您可以像这样在纯 VBA 中执行此操作。如果您有 n 个不同的项目——以 2 为基数从 0 计数到 2^n -1，每个项目对应一个组合（子集）。您似乎想丢弃大小小于 2 的子集。我编写了一个执行此操作的函数，以及一个用于测试它的子集。 sub 假设数据从 A1 开始并且是连续的。它在 B 列中打印结果：

Sub AddItem(C As Collection, x As Variant)
    Dim i As Long
    For i = 1 To C.Count
        If C(i) = x Then Exit Sub
    Next i
    C.Add (x)
End Sub

Function Base2(number As Long, width As Long) As String
    'assumes that width is long enough to hold number
    Dim n As Long, i As Long, r As Long, s As String
    Dim bits As Variant
    ReDim bits(1 To width)
    n = number
    i = width
    Do While n > 0
        r = n Mod 2
        n = Int(n / 2)
        If r > 0 Then bits(i) = 1
        i = i - 1
    Loop
    For i = 1 To width
        s = s & IIf(bits(i) > 0, "1", "0")
    Next i
    Base2 = s
End Function

'in what follows items is a variant array of strings
'it returns a variant array of strings consiting
'of combinations (of size > 1) of strings
Function Combos(items As Variant) As Variant
    Dim i As Long, j As Long, k As Long, m As Long, n As Long
    Dim b As String, s As String
    Dim oneCount As Long
    Dim itemSet As New Collection
    Dim retArray As Variant
    For i = LBound(items) To UBound(items)
        AddItem itemSet, items(i)
    Next i
    n = itemSet.Count
    ReDim retArray(1 To 2 ^ n - n - 1)
    i = 0
    For j = 3 To 2 ^ n - 1
        b = Base2(j, n)
        oneCount = 0
        s = ""
        For k = 1 To n
            If Mid(b, k, 1) = "1" Then
                s = s & itemSet(k)
                oneCount = oneCount + 1
            End If
        Next k
        If oneCount > 1 Then
            i = i + 1
            retArray(i) = s
        End If
    Next j
    Combos = retArray
End Function

Sub test()
    Dim r As Range, v As Variant, i As Long, n As Long
    Set r = Range("A1", Range("A1").End(xlDown))
    n = r.Cells.Count
    ReDim v(1 To n)
    For i = 1 To n
        v(i) = r.Cells(i)
    Next i
    v = Combos(v)
    For i = 1 To UBound(v)
        Range("B:B").Cells(i).Value = v(i)
    Next i
End Sub