从数组创建所有可能的唯一组合的列表(使用 VBA) [英] Creating a list of all possible unique combinations from an array (using VBA)

问题描述

背景:我正在将数据库中的所有字段名称提取到一个数组中 - 我已经毫无问题地完成了这部分工作，所以我已经有了一个包含所有字段 (allfields()) 的数组，并且我有计数有多少个字段(numfields).

Background: I'm pulling all of the field names from a database into an array - I've got this part done without a problem, so I already have an array containing all the fields (allfields()) and I have a count of how many fields there are (numfields).

我现在正在尝试编译可以从这些不同的字段名称组成的所有独特组合.例如，如果我的三个字段是 NAME、DESCR、DATE，我想返回以下内容:

I am now trying to compile all of the unique combinations that can be made from those various field names. For example, if my three fields are NAME, DESCR, DATE, I would want to return the following:

• 名称、描述、日期
• 名称、描述
• 姓名、日期
• 描述、日期
• 姓名
• DESCR
• 日期

为此我尝试了一些不同的方法，包括多个嵌套循环，并在此处修改答案:如何从 VB 中的数组元素进行所有可能的总和组合 以满足我的需要，但似乎我无权访问我的工作 PC 上必需的库(System 或 System.Collections.Generic)，因为它只有 VBA.

I've tried a few different things for this, including multiple nested loops, and modifying the answer here: How to make all possible sum combinations from array elements in VB to fit my needs, but it appears as though I do not have access to the necessary libaries (System or System.Collections.Generic) on my work PC, as it only has VBA.

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

Does anyone have a bit of VB code kicking around that would fulfill this purpose?

非常感谢！

推荐答案

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

I had a similar requirement some years ago. I do not remember why and I no longer have the code but I do remember the algorithm. For me this was a one-off exercise so I wanted an easy code. I did not care about efficiency.

我将假设基于一个的数组，因为它使解释稍微容易一些.由于 VBA 支持基于 1 的数组，因此这应该没问题，尽管如果您需要，可以轻松调整到基于 0 的数组.

I will assume one-based arrays because it makes for a marginally easier explanation. Since VBA supports one-based arrays, this should be OK although it is an easy adjustment to zero-based arrays if that is what you want.

AllFields(1 To NumFields) 保存名称.

AllFields(1 To NumFields) holds the names.

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

Have a Loop: For Inx = 1 To 2^NumFields - 1

在循环中将 Inx 视为二进制数，位编号为 1 到 NumFields.对于 1 和 NumFields 之间的每个 N，如果位 N 为 1，则在此组合中包含 AllFields(N).

Within the loop consider Inx as a binary number with bits numbered 1 to NumFields. For each N between 1 and NumFields, if bit N is one include AllFields(N) in this combination.

此循环生成 2^NumFields - 1 个组合:

This loop generates the 2^NumFields - 1 combinations:

Names: A B C

Inx:          001 010 011 100 101 110 111

CombinationS:   C  B   BC A   A C AB  ABC

VBA 的唯一困难是获取 Bit N 的值.

The only difficulty with VBA is getting the value of Bit N.

额外部分

由于每个人都在努力实现我的算法，我想我最好展示一下我是如何做到的.

With everyone having at go at implementing bits of my algorithm, I thought I had better show how I would have done it.

我用一组令人讨厌的字段名称填充了一组测试数据，因为我们没有被告知名称中可能包含哪些字符.

I have filled an array of test data with an nasty set of field names since we have not been told what characters might be in a name.

子程序 GenerateCombinations 完成这项工作.我是递归的粉丝，但我认为我的算法不够复杂，不足以证明在这种情况下使用它是合理的.我将结果返回到我更喜欢串联的锯齿状数组中.GenerateCombinations 的输出被输出到立即窗口以展示其输出.

The subroutine GenerateCombinations does the business. I am a fan of recursion but I do not think my algorithm is complicated enough to justify its use in this case. I return the result in a jagged array which I prefer to concatenation. The output of GenerateCombinations is output to the immediate window to demonstrate its output.

Option Explicit

此例程演示 GenerateCombinations

This routine demonstrates 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 负责业务.

GenerateCombinations does the business.

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

这篇关于从数组创建所有可能的唯一组合的列表(使用 VBA)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！