什么可能会减慢我的Excel VBA宏？

该函数遍历所有整数并只用五个整数值挑出二进制值并将它们写入电子表格。什么可能会减慢我的Excel VBA宏？

运行这个For x = 1 To 134217728需要2.5天！帮帮我！

我怎么能加快速度？

Function D2B(ByVal n As Long) As String 
    n = Abs(n) 
    D2B = "" 
    Do While n > 0 
     If n = (n \ 2) * 2 Then 
      D2B = "0" & D2B 
     Else 
      D2B = "1" & D2B 
      n = n - 1 
     End If 
     n = n/2 
    Loop 
End Function 

Sub mixtures() 
    Dim x As Long 
    Dim y As Integer 
    Dim fill As String 
    Dim mask As String 
    Dim RowOffset As Integer 
    Dim t As Date 

    t = Now 

    fill = "" 

    For x = 1 To 134217728 
     mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x)))) 

     Debug.Print mask 

     If x > 100000 Then Exit For 

     If Len(mask) - Len(WorksheetFunction.Substitute(mask, "1", "")) = 5 Then _ 
     RowOffset = RowOffset + 1 

     For y = 1 To Len(mask) 
      If Len(mask) - Len(WorksheetFunction.Substitute(mask, "1", "")) = 5 Then _ 
      Range("mix").Offset(RowOffset).Cells(y) = Mid(mask, y, 1) 
     Next 
    Next 

    Debug.Print DateDiff("s", Now, t) 
End Sub

来源

2011-03-29 user681571

通过一见钟情的猜测，我认为问题在于您逐个单元格执行该操作，这会导致许多读取和写入访问。

你应该做的范围内的范围，例如

vArr = Range("A1:C1000").Value 
' it is array now, do something here effeciently 
Range("A1:C1000").Value = vArr

来源

2011-03-29 07:57:53

确实，单元访问太慢了 – 2011-03-29 08:03:27

你想找到所有28bit数字5 1S

有28 * 27 * 26 * 25 * 24/5/4/3/2 = 98280这样的数字

下面的代码把到10秒我的PC上：

lineno = 1 
For b1 = 0 To 27 
    For b2 = b1 + 1 To 27 
     For b3 = b2 + 1 To 27 
      For b4 = b3 + 1 To 27 
       For b5 = b4 + 1 To 27 
        Cells(lineno, 1) = 2^b1 + 2^b2 + 2^b3 + 2^b4 + 2^b5 
        lineno = lineno + 1 
       Next 
      Next 
     Next 
    Next 
Next

来源

2011-03-29 08:05:15 adrianm

另外，如果你想要执行时间<1秒而不是10秒，请参阅@Dante Jiang的回答。 – 2011-03-29 08:16:46

mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x))))

上述代码行执行两次相同的操作（CStr(D2B(x))）。
将CStr(D2B(x))的结果存储在一个变量中&在上面的代码行中使用该变量。

来源

2011-03-29 08:22:51 shahkalpesh

我有2点建议：

在D2B计数的人/零摆脱替换命令中，如果计数不等于5
写这些预返回一个空字符串首先将已过滤的位串转换为数组，然后在完成时将数组直接复制到单元格中。

喜欢的东西

ws.Range(ws.cells(1, 1), ws.cells(UBound(dstArr, 1) + 1, UBound(dstArr, 2) + 1)) = dstArr

数组复制帽子戏法极大地提高了性能！

来源

2011-03-29 08:29:05

什么可能会减慢我的Excel VBA宏？

回答

相关问题