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：加速我的数组二进制加法

1 个答案: