VBA Visual Basic，数组在32,768行后停止给出结果，带有递归的组合代码

Question

我有一个代码可以在excel中制作Fantasy Sports组合，它可以完美完美地显示多达32,000行。当我在此基础上优化结果时，一点问题都没有，但是有时候我想要50至10万行的组合，但是这还不够。

所以，我最初的想法是我有一个名为Integer的变量，但我没有看到一个变量，而且我真的没有想法。

以下是工作或“合并”时的外观图片：

下面是当它不工作或“不合并”时的外观的图片：

这是我用于工作的阵列： （选定的单元格，使用的列）

只要结果在32,000行以下，它就会起作用，当我使该单元格范围更像一组100个单元格时，它就会显示NOT WORKING结果。

这是我正在使用的相应代码：

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

我会将其视为一个组合问题，例如从一定数量的可能的乐透号码中选择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个名字，并得到以下组合。

我不确定您如何获得超过32k的组合，除非您有很多独特的名称。我想60多个唯一名称会使您超过32,000行。

Answer 2

@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