Question

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

我已经在vba中编写了这个代码，并且在尝试以小规模解决问题时遇到了一些问题。首先，我的代码产生了很多重复。例如，当我将表设置为3个位置时，我生成28个结果，而我应该只得到8.其次，我的代码非常慢。

如何以更快的速度制作更健壮的桌子的任何提示或提示将非常感谢!!以下是我一直在使用的小规模代码......

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

Answer 1

参考这篇文章，了解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

此外，如果您的数字足够大，请务必注意Excel's precision limits。

Answer 2

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

宏不是超快，因此这种变化计算大约每秒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

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

2 个答案: