如何使用vba創建二進制序列？

我期待創建一個Excel表格，它可以表示最多20個位置的二進制序列，即2^20。我研究過使用excel公式dec2bin，不幸的是它只產生一個二進制序列，最多10個地方，即2^10。我需要生成一個更大的二進制序列。如何使用vba創建二進制序列？

我已經在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

來源

2015-12-15 Elliott White

我開始[這裏]（http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros） – Raystafarian

參考這篇文章的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。

來源

2015-12-15 16:29:50 thephez

這看起來像一個真正的優雅的方案。不幸的是，我得到一個編譯錯誤：Dec2Bin函數中的sub或函數未定義消息。我在網上查找了這個問題的解決方案，並啓用了我的分析工具包 - vba add in，用於excel，並且還在vba參考菜單中添加了我的atpvbaen.xls。不幸的是，這些修復程序都沒有工作。我正在使用Excel 2013，關於如何解決這個問題的更多想法？ –

@ElliottWhite，你是否從我的答案的第一個鏈接中獲取了Dec2Bin函數？它不是Excel提供的功能，所以這可能是問題。我已經打開的引用是Visual Basic for Applications，OLE自動化，Microsoft Excel 14.0對象庫和Microsoft Office 14.0對象庫（我正在使用Excel 2010）。 – thephez

是的，我使用相同的插件。也許它是一個Excel 2013的東西。也就是說，我設法調整差異代碼來創建一個二進制序列，該序列可以工作，並將作爲我的問題的答案發布。 –

從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

來源

2016-01-08 11:00:54

如何使用vba創建二進制序列？

回答

相關問題