Возможно ли увеличить быстродействие макроса

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
frogy
Сообщения: 8
Зарегистрирован: 22 июн 2009, 21:29

Возможно ли как-нибудь увеличить скорость работы макроса :) , а то две таблицы в 10000 столбцов перебирает ну оооочень долго. заранее спасибо
Button1.Enabled = False
Dim b, cabl As String
Dim a, c As Range
Application.ScreenUpdating = False
Строка = Worksheets("VESSEL").Range("A65536").End(xlUp).Row
r = "B2:G" & Строка
Строка2 = Worksheets("RTCs 25.08-24.09").Range("B65536").End(xlUp).Row
r2 = "E3:P" & Строка2
i = 0: j = 0
For j = 1 To Строка2
For i = 1 To Строка
Set a = Worksheets("VESSEL").Range(r)
b = CStr(a(i, 1))
Set c = Worksheets("RTCs 25.08-24.09").Range(r2)
cabl = c(j, 1)
If cabl = b Then
c(j, 11) = a(i, 5): c(j, 12) = a(i, 6)
End If

Next i
i = 0
Next j
Аватара пользователя
Busine2009
Сообщения: 322
Зарегистрирован: 18 июл 2009, 15:34
Контактная информация:

Этот код был записан с помощью макрорекордера?
Вообще можно ускорить выполнение макросов, используя другие операторы. В твоём случае не знаю, можно это сделать или нет. Но в Word есть такая ситуация: для написания кода для форматирования таблиц можно использовать макрорекродер, а можно использовать код из Word 6.0. Второй макрос работает существенно быстрее, хотя и был создан раньше чем Word 2003. Отсюда вывод: программисты тупят.
Аватара пользователя
EducatedFool
Сообщения: 197
Зарегистрирован: 06 апр 2008, 14:03
Откуда: Россия, Урал
Контактная информация:

Возможно ли как-нибудь увеличить скорость работы макроса
Конечно можно. Причём, несколькими способами.

1) используем формулы вместо макроса.

2) считываем макросом значения 2 диапазонов в 2 массива, обрабатываем эти массивы, и записываем массивы обратно на лист.
В этом случае макрос отработает максимум за 2-3 секунды.

3) можно использовать Find, Autofilter, и т.д. и т.п.

Без примера файла, и описания того, что должен делать макрос, помочь с решением сложно.
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
Попробуйте что-то вроде этого:

Код: Выделить всё

Sub [B]test[/B]()
    Dim b [B]As String[/B], cabl As String
    Dim ra1 As Range, ra2 As Range, arr1 As Variant, arr2 As Variant
    Application.ScreenUpdating = False

    With Worksheets("VESSEL")
        Set ra1 = .Range("B2:G" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With

    With Worksheets("RTCs 25.08-24.09")
        Set ra2 = .Range("E3:P" & .Range("B" & .Rows.Count).End(xlUp).Row)
    End With

    arr1 = ra1.Value: arr2 = ra2.Value ' чтение с листа в массивы

    For j = LBound(arr2) To UBound(arr2)
        For i = LBound(arr1) To UBound(arr1)
            b = CStr(arr1(i, 1))
            cabl = arr2(j, 1)
            If cabl = b Then arr2(j, 11) = arr1(i, 5): arr2(j, 12) = arr1(i, 6)
        Next i
    Next j

    ra1.Value = arr1: ra2.Value = arr2 ' запись обратно на лист
    Application.ScreenUpdating = True
End Sub
Макросы для Excel, Word, CorelDRAW. Быстро, профессионально, недорого. http://ExcelVBA.ru/

Благодарности принимаются на кошелёк WebMoney: R318574877619 и Яндекс.Деньги: 41001335672216
frogy
Сообщения: 8
Зарегистрирован: 22 июн 2009, 21:29

круть, я его вчера целый день писал)))) а тут за 5 минут и так быстро работает )))) круть, мега спасибо
пойду читать матчасть
Ответить