As simple as possible about sorting combinations in real business problems

If you start looking for material about enumerating combinations, there are a lot of examples of how to sort through all combinations of all letters or all numbers. But how to create all the combinations of matrix elements, in which the dimensionality is unknown beforehand, without delving into Joseph Romanovsky and his “Discrete Analysis”, I did not find such material, so I decided to write it here. Suddenly someone will need.

Why Office, Excel, Visual Basic and not OOP? I have already partially answered these questions above. I can also say that this choice is dictated by the specifics of the company for which this algorithm is written and the fact that Office is the main software used by all research managers in our company.

This task is purely applied, arising constantly when using one of the methods of data analysis.

Given :
')

1. On the sheet “data” there is a matrix of undetermined dimension, with an unknown number of elements.
2. The length of each column of the matrix (that is, the number of elements in the column) is not known in advance.
3. The length of the column N with a high probability does not coincide with the length of the column N + 1 and the length of the column N-1.
4. It is known that the length of a certain column of an already formed matrix does not change with time.
5. It is known that the length of the row of the matrix is ​​always the same.
6. The matrix is ​​presented in the Excel table in such a way that each element of the matrix corresponds to one cell with the value of the element. Let's call such a matrix the “initial conditions matrix”.

The task: to create on the sheet “res” all variants of combinations of elements of the matrix of initial conditions with each other. One of the matrix values ​​should not be repeated more than X times.

Well, the algorithm itself, is a working, tested on Excell 2010 script, which I tried to write as simple and clear as possible:

Dim RangeArray() As Integer Dim PositionArray() As Integer Dim ResultArray() As Integer MaxCombination = 3 '   . PresentValue = 1 ' ,     ,  ,        . MaxYSize = 0 '     . IterationCounter = 1 '        res. CombinationCounter = 0 '      . MaxIterationCoutner = 1 '       . PreviousIterationCounter = 0 '     ,   . WorkAreaXSize = Selection.Columns.Count '    . ReDim RangeArray(WorkAreaXSize) ReDim PositionArray(WorkAreaXSize + 1) ReDim ResultArray(WorkAreaXSize) RangeArray(0) = 1 '   .             For Each Column In Selection.Columns '    RangeArray,         . Column.SpecialCells(xlCellTypeConstants).Select WorkAreaYSize = Selection.Cells.Count If WorkAreaYSize > MaxYSize Then MaxYSize = WorkAreaYSize End If RangeArray(Column.Column) = WorkAreaYSize Next '       RangeArray Range(Cells(1, 1), Cells(MaxYSize, WorkAreaXSize)).Select ValueArray = Selection '   ,   . ,    ,       PositionArray ,   RangeArray  ,       . '    ,  ,       .   - ,    - . For i = 1 To WorkAreaXSize PositionArray(i) = 1 Next i For i = 1 To WorkAreaXSize ' ,  ,    i  . For e = 1 To i '       ,   -     . MaxIterationCoutner = MaxIterationCoutner * RangeArray(e) '                . Next e For y = 1 To MaxIterationCoutner '    ResultArray()     PositionArray() If PreviousIterationCounter < y Then '         ,    . For j = 1 To WorkAreaXSize ResultArray(j) = ValueArray(PositionArray(j), j) '    ResultArray()     PositionArray() If ResultArray(j) = PresentValue Then CombinationCounter = CombinationCounter + 1 '     PresentValue,       MaxCombination  End If Next j '  ResultArray(),   '  ResultArray()   res     IterationCounter       If CombinationCounter <= MaxCombination Then For d = 1 To WorkAreaXSize Sheets("res").Cells(IterationCounter, d).Value = ResultArray(d) Next d IterationCounter = IterationCounter + 1 '        End If End If CombinationCounter = 0 '   .  if   . PositionArray(1) = PositionArray(1) + 1 '      PositionArray,   .           ,      RangeArray()      PositionArray() For ErrorCorrections = 1 To WorkAreaXSize If PositionArray(ErrorCorrections) > RangeArray(ErrorCorrections) Then PositionArray(ErrorCorrections) = 1 'If IterationCounter <= MaxIterationCoutner Then ' ,         PositionArray        . ToDo   ,      ,     PositionArray  1,        ,    . PositionArray(ErrorCorrections + 1) = PositionArray(ErrorCorrections + 1) + 1 ' End If End If Next ErrorCorrections Next y PreviousIterationCounter = MaxIterationCoutner ',      . MaxIterationCoutner = 1 '      For s = 1 To WorkAreaXSize PositionArray(s) = 1 Next s Next i '   

Script with a macro and a variant of the matrix of initial conditions:

I will welcome any comments and constructive criticism.