如何使用vba创建二进制序列？

I looking to create an excel table which represents a binary sequence of up to 20 places, i.e. 2^20. I've looked into using the excel formula dec2bin, unfortunately it only produces a binary sequence up to 10 places, i.e. 2^10. I need to produce a binary sequence which is bigger.

我希望创建一个excel表,它表示最多20个位置的二进制序列,即2 ^ 20。我已经研究过使用excel公式dec2bin,不幸的是它只产生了一个最多10个位的二进制序列,即2 ^ 10。我需要生成一个更大的二进制序列。

I've had a stab at coding this up in vba, and suffer from a couple of problems when trying to solve the problem at small scale. First, my code produces a lot of duplicates. For example, when setting my table to 3 places, I produce 28 results when I should only get 8. Second, my code is pretty slow.

我已经尝试在vba中对此进行编码,并且在尝试以小规模解决问题时遇到了一些问题。首先,我的代码产生了很多重复。例如,当我将表格设置为3个位置时,我只能得到8个结果时产生28个结果。其次,我的代码非常慢。

Any hints or tips for how I can produce a more robust table, at a quicker speed would be much appreciated!! And here is the code, at small scale I have been using...

任何有关如何以更快的速度生产更健壮的桌子的提示或提示都将非常感激!!以下是我一直在使用的小规模的代码......

Sub BinarySequence()

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim Length As Integer

Application.ScreenUpdating = False

'Define 1st scenario
x = 1
Range("Start").Value = x 'where "Start" is defined as cell A1

'set default range
Length = Range("Sizei") 'where "Sizei" is defined as 3'
For i = 1 To Length
Range("start").Offset(0, i).Value = 1
Next

'code to generate first level binary sequence (i loop)
For i = 1 To Length

'code to generate second level binary sequence (j loop)
    For j = 1 To Length

'code to generate third level binary sequence (k loop)
        For k = 1 To Length

        x = x + 1
        Range("Start").Offset(0, i).Value = 0
        Range("Start").Offset(0, j).Value = 0
        Range("Start").Offset(0, k).Value = 0

'copy and paste scenario number
        Range("Start").Offset(x - 1, 0).Value = x

'copy and paste result
        Range("Result").Select 'where result is defined as row 1
        Selection.Copy
        Range("Result").Offset(x - 1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'reset scenario select for next loop
        Range("start").Offset(0, k).Value = 1
        Next k

'reset scenario select for next loop
    Range("start").Offset(0, j).Value = 1
    Next j

'reset scenario select for next loop
Range("Start").Offset(0, i).Value = 1
Next i

Application.ScreenUpdating = True

End Sub

2 个解决方案

#1

Reference this post for a VBA DecToBin function - https://groups.google.com/d/msg/comp.lang.visual.basic/KK_-zdrKmLQ/Y36tj5FenJcJ. If I understand the question correctly, you can use that Dec2Bin function with the following logic to generate the table (although it will take a while to do all 20 places):

参考这篇文章,了解VBA DecToBin功能 - https://groups.google.com/d/msg/comp.lang.visual.basic/KK_-zdrKmLQ/Y36tj5FenJcJ。如果我正确理解了这个问题,你可以使用具有以下逻辑的Dec2Bin函数来生成表格(虽然这需要一段时间来完成所有20个位置):

    Sub BinaryTable()

        Size = 12
        StartingRow = 1
        RowIndex = StartingRow

        Application.ScreenUpdating = False

        For i = 0 To (2 ^ Size - 1)
            Cells(RowIndex, "A") = Dec2Bin(i, 20)
            RowIndex = RowIndex + 1
        Next

        Application.ScreenUpdating = True

    End Sub

Also, it can be important to be aware Excel's precision limits if your numbers get large enough.

此外,如果您的数字足够大,了解Excel的精度限制可能很重要。

#2

Solution taken and adapted from the excel forum. Here is a link to the relevant webpage: http://www.excelforum.com/excel-programming-vba-macros/741502-64-bit-binary.html

从excel论坛采取并改编的解决方案。以下是相关网页的链接:http://www.excelforum.com/excel-programming-vba-macros/741502-64-bit-binary.html

The macro isn't super quick, so this variation calculates around 340 lines per second. To create a binary sequence of 2^20, would take around an hour. Any suggestions for speeding up this macro would be gratefully received.

宏不是超快,因此这种变化计算大约每秒340行。要创建2 ^ 20的二进制序列,大约需要一个小时。我们将非常感激地提出加快这一宏观的建议。

Function GetBinary(ByVal Dec) As String

Dim TmpBin
TmpBin = ""

While Dec > 0
  If Dec / 2 = Int(Dec / 2) Then
    TmpBin = TmpBin & "0"
  Else
    TmpBin = TmpBin & "1"
  End If
  Dec = Int(Dec / 2)
Wend

GetBinary = TmpBin

End Function

Sub Split()

Application.ScreenUpdating = False

Dim BinVal
Dim CharLoop
Dim i

For i = 0 To 32999

    BinVal = GetBinary(ActiveCell.Offset(i, 0).Value)

    For CharLoop = 1 To Len(BinVal)
        ActiveCell.Offset(i, CharLoop).Value = Mid(BinVal, CharLoop, 1)
    Next CharLoop

Next i

Application.ScreenUpdating = True

End Sub