要查找列范围中存在的所有可能的string组合（顺序无关紧要，不允许重复）
我想获得列范围内存在的某些值的所有可能的组合，并将它们打印在Excel表格中：
请注意，组合顺序并不重要，即AB = BA
以下是列1中要find哪些组合的数据示例：
F1 F2 F3 F4 这些可能的组合是：
F1F2 F1F3 F1F4 F2F3 F2F4 F3F4 F1F2F3 F1F2F4 F1F3F4 F2F3F4 F1F2F3F4
这是我的第一个堆栈溢出答案：
这可能不是最优雅的方法，但它的工作原理。 首先消除数据中的任何重复。 我的倾向是使用一个VBScript字典 – 但你可以在这样的纯VBA做到这一点。 如果有n个不同的项目 – 基数2从0到2 ^ n -1，每个对应一个组合（子集）。 你似乎想要抛出大小小于2的子集。我写了一个这样做的函数，以及一个sub来testing它。 子假定数据从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