从数组创建所有可能的唯一组合的列表(使用VBA)

Question

背景:我将数据库中的所有字段名称都拉到了数组中 - 我已经完成了这个部分没有问题,所以我已经有一个包含所有字段的数组(allfields())并且我有一个数有多少个字段(numfields).

我现在正在尝试编译可以从各种字段名称中创建的所有唯一组合.例如,如果我的三个字段是NAME,DESCR,DATE,我想返回以下内容:

• NAME,DESCR,DATE
• 名称,DESCR
• 名称日期
• DESCR,日期
• 名称
• DESCR
• 日期

我为此尝试了一些不同的东西,包括多个嵌套循环,并在这里修改答案:如何从VB中的数组元素中创建所有可能的总和组合以满足我的需要,但看起来好像我没有访问权限我的工作PC上必要的库(System或System.Collections.Generic),因为它只有VBA.

有没有人有一些VB代码可以实现这个目的？

非常感谢!

Answer 1

几年前我有类似的要求.我不记得为什么,我不再有代码,但我记得算法.对我来说,这是一次性的练习,所以我想要一个简单的代码.我不关心效率.

我将假设基于单一的数组,因为它使得解释更容易.由于VBA支持基于一个阵列,所以这应该没问题,尽管如果这是你想要的,它可以很容易地调整到基于零的数组.

AllFields(1 To NumFields)保存名称.

有一个循环:对于Inx = 1到2 ^ NumFields - 1

在循环内,将Inx视为二进制数,其编号为1到NumFields.对于1和NumField之间的每个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