Excel - В VBA, как найти все возможные суммы значений в матрице, используя 1 значение в строке?

Question

Я искал вокруг хороший ответ на этот ответ, но ничего не решает мою проблему. Вот что я делаю ...

У меня есть рабочий лист, в котором находится матрица [edit: 16rows x 9cols]. Ячейками матрицы являются положительные и отрицательные целые числа. Вот пример части данных:

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

Чтобы начать, я хотел бы сохранить сумму (-144, -16, 0, -96, -74, 0, 589, -61, -55, -18, -66, 0, - 279, -24, -43, -406). Следующей суммой для хранения будет (-5, -16, 0, -96, -74, 0, 589, -61, -55, -18, -66, 0, -279, -24, -43, - 406).

Я пытаюсь думать об умном способе использования цикла For с операторами GoTo, но я открыт для любых идей. Возможно, рекурсивная функция?

Answer 1

Рекурсию можно решить с помощью рекурсии, но без нее мне легче.

Рассмотрите спидометр. Каждый цикл добавляет один к самой правой цифре. Если эта цифра переполняется от девяти до нуля, вы добавляете ее к следующей цифре влево. Если эта цифра переполняется, вы добавляете ее в цифру слева. Это продолжается до тех пор, пока цифра не переполнится, а крайняя цифра переполняется. Таким образом, значения, которые вы видите на спидометр:

0 0 0 0 
0 0 0 1 
0 0 0 2 
: : : : 
0 0 0 9 
0 0 1 0 
0 0 1 1 
: : : : 
0 0 1 9 
0 0 2 0 
: : : : 
0 0 9 9 
0 1 0 0 
: : : : 
9 9 9 9 

Если цифры спидометра являются записи в целочисленном массиве, простой цикл может цикла через эти значения.

Для вашей проблемы:

• Вам необходимо 16 элементов в массиве, по одному в каждой строке в вашей матрице.
• Каждая цифра может принимать значение от 0 до 55 лет, а не от 0 до 9.

С этим изменением спидометра циклов от:

0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 

в

55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 

Если вы число столбцов от 0 до 55, каждая цифра указывает, какой столбец используется для соответствующей строки.

Одно из значений, через которые ваши циклы спидометра:

1 45 5 30 8 22 1 0 38 51 14 42 29 31 46 7 

Который говорит вам просуммировать:

Column 1 of first row 
Column 45 of second row 
Column 5 of third row 
Column 30 of fourth row 
And so on 

Другой цикл будет извлечь и суммировать эти значения.

Таким образом, внешние петли будут вращать спидометр от {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} до {55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55} , Для каждого значения на спидометре внутренний цикл вычисляет и сохраняет сумму.

Раздел 2

Небольшое изменение необходимо обновить исходный код для нового требования.

В оригинале у меня был «спидометр», который перемещался от (0, 0, 0, ...) до (55, 55, 55, ...) с каждым «колесом», имеющим значения от 0 до 55. У меня есть теперь добавлен массив, который дает максимальное значение для каждого «колеса». Например, первое «колесо» может принимать значения от 0 до 5, которые соответствуют шести значениям, которые должны быть извлечены из матрицы: -144 -5 0 12 16 20 .

5 2 4 8 2 1 1 3 1 5 7 1 8 3 4 5 New maximum values 

    0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 Minimum values 

55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 Old maximum values 

я напечатал данные из образа вашей матрицы в Лист1 новой книги:

Мой макрос импортировал эту матрицу в массив вариантов. Для каждого доступа к переменной типа варианта есть накладные расходы, поэтому я скопировал данные в длинный массив. Чтобы продемонстрировать, что макрос правильно создает массив, я выводю:

Row Lst ---0 ---1 ---2 ---3 ---4 ---5 ---6 ---7 ---8 
    0 5 -144 -5 0 12 16 20 
    1 2 -16 0 50 
    2 4 0 5 8 11 70 
    3 8 -96 -57 -47 -45 -29 -13 -2 0 3 
    4 2 -74 -18 0 
    5 1 0 8 
    6 1 589 0 
    7 3 -61 -44 -26 0 
    8 1 -55 0 
    9 5 -18 0 9 18 50 58 
10 7 -66 -36 0 2 16 46 62 82 
11 1 0 8 
12 8 -279 -272 -253 -229 -165 -121 -74 -38 0 
13 3 -24 -19 -17 0 
14 4 -43 -27 -21 -9 0 
15 5 -406 -91 -64 -29 -3 0 

В колонке «Lst» приводится последняя запись в каждой строке.

Для первой версии макроса, я вывод диагностической информации для первых 200 сумов до Лист2:

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

Для второй версии макроса я удалил весь диагностический код и вывел суммы в файл. Я переключаю файлы после 1,000,000 сум, чтобы сохранить размеры файлов управляемыми. После создания файла 50 макрос вышел. Создание этих 50 файлов заняло 13 минут 15 секунд. В верхней части первого файла:

Затем я перешел на Visual Basic 2010. Я создал приложение Windows с помощью простой формы:

У меня есть шесть элементов управления, которые четыре названы так, как показано, а другой lblMessage не отображается до конца. Значение 8000 для lblFileNumMax заменяется во время выполнения рассчитанным количеством создаваемых файлов. Значение 1 для lblFileNumCrnt обновляется каждый раз, когда создается новый файл. Приблизительно 100 созданных в минуту это обеспечивает адекватное указание прогресса.

Я мог бы загрузить матрицу из Excel, но я решил, что было бы проще жесткого кода. Кроме того, в коде версии VBA мало различий.Я сохранил ловушку, остановленном поколение после 50 файлов был создан и используется пакетный файл для проверки файлов VBA были такими же, как файлы VB:

Del compare.txt 
comp "Sums 0001.txt" "Sums 00001VBA.txt" <N.txt >>Compare.txt 
comp "Sums 0002.txt" "Sums 00002VBA.txt" <N.txt >>Compare.txt 
comp "Sums 0003.txt" "Sums 00003VBA.txt" <N.txt >>Compare.txt 
comp "Sums 0004.txt" "Sums 00004VBA.txt" <N.txt >>Compare.txt 
comp "Sums 0005.txt" "Sums 00005VBA.txt" <N.txt >>Compare.txt 

Я тогда удалены ловушки и позволить программе создать все 8063, что заняло 51 минуту 45 секунд на моем 2,1 ГГц ноутбуке.

Я не могу опубликовать код VBA, потому что я случайно удалил его вместе с файлами 8063, всего 40 Гб, которые были достаточно большими, чтобы привести к переполнению корзины.

Код VB.net приведен ниже.

Option Strict On 
Imports System.IO 

Public Class Form1 
    Dim fileOut As StreamWriter 
    Private Sub cmdStart_Click(sender As System.Object, e As System.EventArgs) Handles cmdStart.Click 

    Dim matrix(,) As Integer = {{-144, -5, 0, 12, 16, 20, 0, 0, 0}, _ 
           {-16, 0, 50, 0, 0, 0, 0, 0, 0}, _ 
           {0, 5, 8, 11, 70, 0, 0, 0, 0}, _ 
           {-96, -57, -47, -45, -29, -13, -2, 0, 3}, _ 
           {-74, -18, 0, 0, 0, 0, 0, 0, 0}, _ 
           {0, 8, 0, 0, 0, 0, 0, 0, 0}, _ 
           {589, 0, 0, 0, 0, 0, 0, 0, 0}, _ 
           {-61, -44, -26, 0, 0, 0, 0, 0, 0}, _ 
           {-55, 0, 0, 0, 0, 0, 0, 0, 0}, _ 
           {-18, 0, 9, 18, 50, 58, 0, 0, 0}, _ 
           {-66, -36, 0, 2, 16, 46, 62, 82, 0}, _ 
           {0, 8, 0, 0, 0, 0, 0, 0, 0}, _ 
           {-279, -272, -253, -229, -165, -121, -74, -38, 0}, _ 
           {-24, -19, -17, 0, 0, 0, 0, 0, 0}, _ 
           {-43, -27, -21, -9, 0, 0, 0, 0, 0}, _ 
           {-406, -91, -64, -29, -3, 0, 0, 0, 0}} 

    Dim lastEntryPerRow() As Integer = {5, 2, 4, 8, 2, 1, 1, 3, 1, 5, 7, 1, 8, 3, 4, 5} 

    Const sumsPerFile As Long = 1000000 

    Dim fileOutNum As Integer 
    Dim fileOutNumMax As Long 
    Dim finished As Boolean 
    Dim numSums As Integer 
    Dim pathProg As String 
    Dim posChar As Int32 
    Dim speedo() As Integer 
    Dim sumCrnt As Integer 
    Dim rowCrnt As Integer 
    Dim rowMax As Integer = matrix.GetUpperBound(0) 
    Dim timeStart As Long 

    cmdStart.Visible = False 
    cmdExit.Visible = False 

    ' Extract folder containing program 
    pathProg = Application.ExecutablePath 
    posChar = InStrRev(pathProg, "\") 
    If posChar <> 0 Then 
     ' Discard the name of the program 
     pathProg = Mid(pathProg, 1, posChar) 
    End If 

    ' Initialise Speedo to all zeros 
    ReDim speedo(rowMax) 
    For rowCrnt = 0 To rowMax 
     speedo(rowCrnt) = 0 
    Next 

    ' Calculate number of files to be created 
    fileOutNumMax = 1 
    For rowCrnt = 0 To rowMax 
     fileOutNumMax *= CLng(lastEntryPerRow(rowCrnt) + 1) 
    Next 
    fileOutNumMax = CInt(fileOutNumMax/sumsPerFile) 

    lblFileNumMax.Text = CStr(fileOutNumMax) 

    ' Initialise control variables 
    numSums = 0 
    fileOutNum = 1 
    finished = False 
    lblFileNumCrnt.Text = CStr(fileOutNum) 
    Application.DoEvents() 

    timeStart = (Hour(DateTime.Now) * 24 + Minute(DateTime.Now)) * 60 + Second(DateTime.Now) 

    Do While True 

     ' False means overwrite if file already exists 
     fileOut = New StreamWriter(pathProg & "\Sums " & Format(fileOutNum, "0000") & ".txt", False) 

     Do While True 

     ' Output sum identified by current value of Speedo 
     sumCrnt = 0 
     numSums = numSums + 1 
     For rowCrnt = 0 To rowMax 
      sumCrnt += matrix(rowCrnt, speedo(rowCrnt)) 
     Next 
     fileOut.WriteLine(sumCrnt) 

     ' Generate next value for Speedo 
     ' Process entries from left to right 
     For rowCrnt = 0 To rowMax 
      If speedo(rowCrnt) = lastEntryPerRow(rowCrnt) Then 
      ' This column is about to overflow 
      speedo(rowCrnt) = 0 
      If rowCrnt = rowMax Then 
       ' rightmost entry has overflowed. All done 
       finished = True 
       Exit Do 
      End If 
      ' Continue with For-Loop to step next column to right 
      Else 
      ' This column is not about to overflow 
      speedo(rowCrnt) = speedo(rowCrnt) + 1 
      ' Have finished generation 
      Exit For 
      End If 
     Next 

     If numSums >= sumsPerFile Then 
      Exit Do 
     End If 

     Loop 

     fileOut.Close() 
     fileOut = Nothing 
     numSums = 0 
     fileOutNum = fileOutNum + 1 
     'If fileOutNum >= 51 Then 
     ' Exit Do 
     'End If 
     If finished Then 
     Exit Do 
     End If 
     lblFileNumCrnt.Text = CStr(fileOutNum) 
     Application.DoEvents() 

    Loop 

    Debug.Print(CStr((Hour(DateTime.Now) * 24 + Minute(DateTime.Now)) * 60 + _ 
         Second(DateTime.Now) - timeStart) & " seconds") 

    cmdExit.Visible = True 

    End Sub 
    Private Sub cmdExit_Click(sender As System.Object, e As System.EventArgs) Handles cmdExit.Click 

    If fileOut IsNot Nothing Then 
     fileOut.Close() 
     fileOut = Nothing 
    End If 

    Me.Close() 

    End Sub 
End Class