Создание списка всех возможных уникальных комбинаций из массива (с использованием VBA) - PullRequest
2 голосов
/ 06 января 2012

Предыстория: я вытягиваю все имена полей из базы данных в массив - я выполнил эту часть без проблем, поэтому у меня уже есть массив, содержащий все поля (allfields ()), и у меня естьподсчет количества полей (numfields).

Сейчас я пытаюсь скомпилировать все уникальные комбинации, которые можно составить из этих различных имен полей.Например, если моими тремя полями являются ИМЯ, ОПИСАНИЕ, ДАТА, я бы хотел вернуть следующее:

  • ИМЯ, ОПИСАНИЕ, ДАТА
  • ИМЯ, ОПИСАНИЕ
  • ИМЯ, ДАТА
  • DESCR, ДАТА
  • ИМЯ
  • DESCR
  • ДАТА

Я пробовал несколько разныхвещи для этого, в том числе несколько вложенных циклов и изменение ответа здесь: Как сделать все возможные комбинации сумм из элементов массива в VB , чтобы соответствовать моим потребностям, но похоже, что у меня нет доступа кнеобходимые библиотеки (System или System.Collections.Generic) на моем рабочем ПК, поскольку он имеет только VBA.

У кого-нибудь есть немного кода на VB, который мог бы выполнить эту задачу?

Большое спасибо!

Ответы [ 3 ]

6 голосов
/ 06 января 2012

У меня было подобное требование несколько лет назад. Я не помню, почему, и у меня больше нет кода, но я помню алгоритм. Для меня это было одноразовое упражнение, поэтому я хотел простой код. Я не заботился об эффективности.

Я буду использовать одноосновные массивы, потому что это упрощает объяснение. Поскольку VBA поддерживает одноосновные массивы, все должно быть в порядке, хотя это простая настройка для массивов, начинающихся с нуля, если вы этого хотите.

AllFields (от 1 до NumFields) содержит имена.

Есть цикл: для Inx = 1 до 2 ^ NumFields - 1

В цикле рассматривайте Inx как двоичное число с битами, пронумерованными от 1 до NumFields. Для каждого N от 1 до NumFields, если бит N равен единице, включите 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 - получить значение Бита N.

Дополнительная секция

Поскольку каждый имел возможность реализовать биты моего алгоритма, я подумал, что лучше показать, как я это сделал.

Я заполнил массив тестовых данных неприятным набором имен полей, поскольку нам не сказали, какие символы могут быть в имени.

Подпрограмма GenerateCombination делает бизнес. Я фанат рекурсии, но я не думаю, что мой алгоритм достаточно сложен, чтобы оправдать его использование в этом случае. Я возвращаю результат в неровном массиве, который я предпочитаю конкатенации. Вывод GenerateCombination выводится в непосредственное окно, чтобы продемонстрировать его вывод.

Option Explicit

Эта процедура демонстрирует комбинации Generate

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

GenerateCombination делает бизнес.

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
2 голосов
/ 07 января 2012

Вот код, который будет делать то, что вы хотите. Он присваивает ноль или единицу каждому элементу и объединяет элементы, которым назначен один. Например, с четырьмя элементами у вас есть 2 ^ 4 комбинации. Представленный в виде нулей и единиц, он будет выглядеть как

0000
0001
0010
0100
1000
0011
0101
1001
0110
1010
1100
0111
1011
1101
1110
1111

Этот код создает массив (maInclude), который реплицирует все 16 из этих сценариев и использует соответствующий элемент mvArr для объединения результатов.

Option Explicit

Dim mvArr As Variant
Dim maResult() As String
Dim maInclude() As Long
Dim mlElementCount As Long
Dim mlResultCount As Long

Sub AllCombos()

    Dim i As Long

    'Initialize arrays and variables
    Erase maInclude
    Erase maResult
    mlResultCount = 0

    'Create array of possible substrings
    mvArr = Array("NAME", "DESC", "DATE", "ACCOUNT")

    'Initialize variables based on size of array
    mlElementCount = UBound(mvArr)
    ReDim maInclude(LBound(mvArr) To UBound(mvArr))
    ReDim maResult(1 To 2 ^ (mlElementCount + 1))

    'Call the recursive function for the first time
    Eval 0

    'Print the results to the immediate window
    For i = LBound(maResult) To UBound(maResult)
        Debug.Print i, maResult(i)
    Next i

End Sub


Sub Eval(ByVal lPosition As Long)

    Dim sConcat As String
    Dim i As Long

    If lPosition <= mlElementCount Then
        'set the position to zero (don't include) and recurse
        maInclude(lPosition) = 0
        Eval lPosition + 1

        'set the position to one (include) and recurse
        maInclude(lPosition) = 1
        Eval lPosition + 1
    Else
        'once lPosition exceeds the number of elements in the array
        'concatenate all the substrings that have a corresponding 1
        'in maInclude and store in results array
        mlResultCount = mlResultCount + 1
        For i = 0 To UBound(maInclude)
            If maInclude(i) = 1 Then
                sConcat = sConcat & mvArr(i) & Space(1)
            End If
        Next i
        sConcat = Trim(sConcat)
        maResult(mlResultCount) = sConcat
    End If

End Sub

Из-за рекурсии у меня болит голова, но она сильна. Этот код был адаптирован из Найшад Раджани, чей оригинальный код можно найти по адресу http://www.dailydoseofexcel.com/archives/2005/10/27/which-numbers-sum-to-target/

0 голосов
/ 06 января 2012

на основе ответа Тони: (где A = 4, B = 2, C = 1)

(следующий псевдокод)

If (A And Inx <> 0) then
  A = True
end if
...