Question

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

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

以下是column1中可以找到组合的数据示例：

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的子集。我写了一个函数来做这个，以及一个子来测试它。子假定数据从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

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

1 个答案: