几年前我也有类似的要求。我不记得为什么,我不再有代码,但我记得算法。对我来说,这是一次性练习,所以我想要一个简单的代码。我不在乎效率。
我将假设基于 1 的数组,因为它使解释稍微容易一些。由于 VBA 支持从 1 开始的数组,这应该没问题,尽管如果你想要的话,它可以很容易地调整到从 0 开始的数组。
AllFields(1 To NumFields) 保存名称。
有一个循环:对于 Inx = 1 To 2^NumFields - 1
在循环中,将 Inx 视为二进制数,位编号为 1 到 NumFields。对于 1 和 NumFields 之间的每个 N,如果位 N 为 1,则在此组合中包含 AllFields(N)。
此循环生成 2^NumFields - 1 个组合:
Names: A B C
Inx: 001 010 011 100 101 110 111
CombinationS: C B BC A A C AB ABC
VBA 的唯一困难是获取 Bit N 的值。
额外部分
由于每个人都在努力实现我的算法,我想我最好展示一下我会怎么做。
我已经用一组讨厌的字段名称填充了一组测试数据,因为我们没有被告知名称中可能包含哪些字符。
子例程 GenerateCombinations 执行此操作。我是递归的粉丝,但我不认为我的算法复杂到足以证明在这种情况下使用它是合理的。我将结果返回到一个我更喜欢连接的锯齿状数组中。 GenerateCombinations 的输出被输出到即时窗口以展示它的输出。
Option Explicit
此例程演示 GenerateCombinations
Sub Test()
Dim InxComb As Integer
Dim InxResult As Integer
Dim TestData() As Variant
Dim Result() As Variant
TestData = Array("A A", "B,B", "C|C", "D;D", "E:E", "F.F", "G/G")
Call GenerateCombinations(TestData, Result)
For InxResult = 0 To UBound(Result)
Debug.Print Right(" " & InxResult + 1, 3) & " ";
For InxComb = 0 To UBound(Result(InxResult))
Debug.Print "[" & Result(InxResult)(InxComb) & "] ";
Next
Debug.Print
Next
End Sub
GenerateCombinations 做生意。
Sub GenerateCombinations(ByRef AllFields() As Variant, _
ByRef Result() As Variant)
Dim InxResultCrnt As Integer
Dim InxField As Integer
Dim InxResult As Integer
Dim I As Integer
Dim NumFields As Integer
Dim Powers() As Integer
Dim ResultCrnt() As String
NumFields = UBound(AllFields) - LBound(AllFields) + 1
ReDim Result(0 To 2 ^ NumFields - 2) ' one entry per combination
ReDim Powers(0 To NumFields - 1) ' one entry per field name
' Generate powers used for extracting bits from InxResult
For InxField = 0 To NumFields - 1
Powers(InxField) = 2 ^ InxField
Next
For InxResult = 0 To 2 ^ NumFields - 2
' Size ResultCrnt to the max number of fields per combination
' Build this loop's combination in ResultCrnt
ReDim ResultCrnt(0 To NumFields - 1)
InxResultCrnt = -1
For InxField = 0 To NumFields - 1
If ((InxResult + 1) And Powers(InxField)) <> 0 Then
' This field required in this combination
InxResultCrnt = InxResultCrnt + 1
ResultCrnt(InxResultCrnt) = AllFields(InxField)
End If
Next
' Discard unused trailing entries
ReDim Preserve ResultCrnt(0 To InxResultCrnt)
' Store this loop's combination in return array
Result(InxResult) = ResultCrnt
Next
End Sub