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

我想创build一个表格，代表一个二进制序列，最多20个位置，即2 ^ 20。 我研究过使用excel公式dec2bin，不幸的是它只产生一个二进制序列，最多10个地方，即2 ^ 10。 我需要生成一个更大的二进制序列。

我在刺激vba编码方​​面遇到了一些问题，并且在小规模解决这个问题时遇到了一些问题。 首先，我的代码产生了很多重复。 例如，当我将表格设置为3个位置时，我只能得到8个结果，而产生28个结果。其次，我的代码非常慢。

任何提示或提示如何以更快的速度生产更坚固的桌子将非常感谢！ 这里是代码，我一直在使用小规模…

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函数和下面的逻辑来生成表（尽pipe需要一段时间才能完成所有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的精度限制 。

Answer 2

从excel论坛采取和改编的解决scheme。 这是一个链接到相关的网页： http : //www.excelforum.com/excel-programming-vba-macros/741502-64-bit-binary.html

macros不是很快，所以这个变化每秒计算大约340行。 要创build2 ^ 20的二进制序列，需要大约一个小时。 任何加速这个macros的build议将受到感谢。

 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