Excel VBA: 加速我的数组的二进制加法

Question

在我的 VBA 模块中，我有一个动态长度的数组，它可以在每个元素中取值 0 或 1。我需要生成所有排列组合，然后在其他一些计算中使用它。

示例：{0, 0, 0, 0, 0}，{0, 0, 0, 0, 1}，{0, 0, 0, 1, 0}，{0, 0, 1, 0, 0}, {0, 1, 0, 0, 0}, {1, 0, 0, 0, 0}, {1, 0, 0, 0, 1} 等

因此，我将每个元素视为一个位并将 0 切换为 1，反之亦然模拟二进制加法 - 0000、0001、0010、0011、0100 等。

下面是我的代码。它工作正常，但呈指数级变慢。感谢您的意见，帮助我更快地优化此代码运行。

Dim lastPos As Long

Sub Main()
    Dim myArray(1 to 100, 1) As Long

    'something
    'something
    'something

    While Not Not myArray
        DoEvents

        'Do something with myArray

        byteAdd myArray
    Wend
End Sub

Sub byteAdd(ByRef inArray() As Long)
    Dim i As Long

    i = UBound(inArray)
    If (inArray(i, 1) = 0) Then
        inArray(i, 1) = 1
        lastPos = i
    Else
        For i = lastPos - 1 To 1 Step -1
            If (inArray(i, 1) = 0) Then
                Dim j As Long
                inArray(i, 1) = 1

                For j = i + 1 To UBound(inArray)
                    inArray(j, 1) = 0
                Next j

                Exit Sub
            End If
        Next i

        Erase inArray
    End If
End Sub

我尝试了一些其他技术... 1）我试图将一个十进制数从 0 递增到最大十进制数 11111（数组长度），然后将十进制数转换为二进制数。但是，Excel 有 10 个字符的限制

2) 我尝试使用 String() 和 ReDim Preserve 在最后 1 处截断数组或 CSV 字符串，并使用 String() 填充剩余的零，而不是循环。不幸的是，如您所见，它是一个二维数组，并且该方法不起作用

3) 使用数据类型 Byte 而不是 Long 似乎不起作用，但更喜欢 Long，因为数组需要进行数学计算。

感谢任何解决方案。

Answer 1

这可能会有所帮助。主子 (AddOne) 在基于 0 和基于 1 的数组之间是不可知的。测试子在几分之一秒内运行：

Sub AddOne(binaryVector As Variant)
'adds one to an array consisting of 0s and 1s
'the vector is modified in place
'all 1's wraps around to all 0's
    Dim bit As Long, carry As Long, i As Long, ub As Long, lb As Long
    carry = 1
    lb = LBound(binaryVector)
    ub = UBound(binaryVector)
    i = ub
    Do While carry = 1 And i >= lb
        bit = (binaryVector(i) + carry) Mod 2
        binaryVector(i) = bit
        i = i - 1
        carry = IIf(bit = 0, 1, 0)
    Loop
End Sub

Sub test()
    Dim bvect(1 To 10) As Long
    Dim bvects(1 To 1024, 1 To 10) As Long
    Dim i As Long, j As Long
    For i = 1 To 1024 '=2^10
        For j = 1 To 10
            bvects(i, j) = bvect(j)
        Next j
        AddOne bvect
    Next i
    Range("A1:J1024").Value = bvects
End Sub

Excel VBA: 加速我的数组的二进制加法

Excel VBA: Speed up my Array's Binary like addition

arrays

vba

excel

binary