Что может замедлить работу моего макроса Excel VBA? - PullRequest
Новая
       22

Что может замедлить работу моего макроса Excel VBA?

1 голос
/ 29 марта 2011

Эта функция просматривает все целые числа, выбирает двоичные значения только из пяти и записывает их в электронную таблицу.

Для запуска 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

Ответы [ 4 ]

2 голосов
/ 29 марта 2011

На первый взгляд, я думаю, что проблема заключается в том, что вы делаете эту ячейку за ячейкой, что вызывает много обращений к чтению и записи.

Вы должны сделать это по диапазону, как 

vArr = Range("A1:C1000").Value
' it is array now, do something here effeciently
Range("A1:C1000").Value = vArr
1 голос
/ 29 марта 2011

Вы хотите найти все 28-битные числа с 5 1s

. Есть 28 * 27 * 26 * 25 * 24/5/4/3/2 = 98280 таких номеров

Следующий кодзаняло ~ 10 секунд на моем ПК: 

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
0 голосов
/ 29 марта 2011

У меня есть 2 предложения:

  • Избавьтесь от команды подстановки, посчитав единицы / нули в D2B, и верните пустую строку, если счет не равен 5
  • Сначала запишите эти предварительно отфильтрованные строки битов в массив и скопируйте массив непосредственно в ячейки, когда закончите.

Что-то вроде 

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

Трюк с копированием массива значительно повышает производительность!

0 голосов
/ 29 марта 2011 
mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x))))

Приведенная выше строка кода дважды повторяет одно и то же (CStr(D2B(x))).
Сохраните результат CStr(D2B(x)) в переменной и используйте эту переменную в приведенной выше строке кода.

...