VBA Visual Basic, массив перестает давать результаты после 32 768 строк, код комбинации с рекурсией

Question

У меня есть код, который я использую для создания комбинаций Fantasy Sports в Excel, и он прекрасно работает до 32 000 строк.Когда я уточнил результаты в соответствии с этим, никаких проблем не возникало, но иногда я хотел комбинации для 50-100 тыс. Строк, и этого было бы недостаточно.

Итак, моя первоначальная мысль была, что у меня есть переменная с именем Integer, но я делаюЯ не вижу никого, и я действительно вне идей.

Ниже приведено изображение того, как оно выглядит, когда оно РАБОТАЕТ или «комбинируется»:

Нижеэто рисунок того, как он выглядит, когда он НЕ РАБОТАЕТ или «не объединяется»:

Массив, который я использую для рабочего: (выбранные ячейки, используемые столбцы)

И пока результаты работают под 32 000 строк, это работает, когда я делаю этот диапазон ячеек более похожим на группу из 100 ячеек, он показывает НЕ РАБОТАЮЩИЙрезультат.

Вот соответствующий код, который я использую:

Public result() As Variant
------

Function Combinations(rng As Range, n As Long)
rng1 = rng.Value

ReDim result(n - 1, 0)

Call Recursive(rng1, n, 1, 0)

ReDim Preserve result(UBound(result, 1), UBound(result, 2) - 1)
Combinations = Application.Transpose(result)

End Function
------
Function Recursive(r As Variant, c As Long, d As Long, e As Long)

Dim f As Long


For f = d To UBound(r, 1)

result(e, UBound(result, 2)) = r(f, 1)

If e = (c - 1) Then

ReDim Preserve result(UBound(result, 1), UBound(result, 2) + 1)

For g = 0 To UBound(result, 1)
result(g, UBound(result, 2)) = result(g, UBound(result, 2) - 1)
Next g
Else
Call Recursive(r, c, f + 1, e + 1)
End If

Next f

End Function

Если у кого-то есть идеи, как расширить его за пределы 32 000 строк, или если мне не хватает какой-то переменной, которая не позволяетэто держать больше данных, дайте мне знать.

Спасиботак очень!

Answer 1

@ PortlandRunner находится на правильном пути, я написал свою собственную функцию транспонирования из-за ограничения на Application.Transpose.Довольно просто, из памяти получается что-то вроде этого:

Public Function TransposeArray(byval arrIn as variant) as variant

Dim arrOut as variant

Dim lngRow as long
Dim lngCol as long

Redim arrout(lbound arrin,2) to ubound(ArrIn,2),lbound(arrIn,1) to ubound(arrIn,1))

For lngrow =lbound(arrIn,1) to ubound(arrIn,1)
    For lngCol =lbound(arrIn,2) to ubound(arrIn,2)
        Arrout(lngCol,lngrow) = arrin(lngrow, lngCol)
    Next lngCol 
Next lngrow 

TransposeArray = arrout

End function 

Answer 2

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

Sub Combinations()

Dim Combo()

Data = Array("Tim", "Tom", "Debbie", "Sally", "Sam", "Todd", "Ted", "Mike", "Dan", "Matt")
DataLen = UBound(Data) + 1

Do
   Size = Val(InputBox("Enter Size from 1 to " & DataLen))

Loop While Size <= 0 And Size > DataLen

ReDim Combo(Size)
Level = 1
RowCount = 1
ActiveSheet.Cells.ClearContents
Call Recursive(Data, Combo(), Level, Size, RowCount)

End Sub
Sub Recursive(Data, Combo, Level, Size, RowCount)

DataLen = UBound(Data) + 1
'make combination
For Count = (Combo(Level - 1) + 1) To _
   DataLen - (Size - Level)

   Combo(Level) = Count
   If Level = Size Then
      For ColCount = 1 To Size
         Cells(RowCount, ColCount) = _
            Data(Combo(ColCount) - 1)
      Next ColCount
      RowCount = RowCount + 1
   Else
      Call Recursive(Data, Combo, Level + 1, Size, RowCount)
   End If
Next Count
End Sub

Я выбрал 3 имени из списка и получил следующие комбинации.

Я не уверен, как вы получаете более 32 тыс. Комбинаций, если только у вас нет множества уникальных имен.Я предполагаю, что более 60 уникальных имен приведут вас к более чем 32 тысячам строк.