我希望获得列范围中存在的某些值的所有可能组合,并将它们打印在Excel工作表中:
请注意,组合的顺序无关紧要,即AB = BA
以下是column1中可以找到组合的数据示例:
F1
F2
F3
F4
这些的可能组合是:
F1F2
F1F3
F1F4
F2F3
F2F4
F3F4
F1F2F3
F1F2F4
F1F3F4
F2F3F4
F1F2F3F4
答案 0 :(得分: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