VBA, optymalizacja kodu

Question

Witam.

Na początku może dodam, że zaczynam przygodę z VBA. Poniższy algorytm, jesli zajdą odpowiednie warunki, pobiera dane z Arkusza1, na ich podstawie szuka danych w Arkuszu2 i kopiuje do Arkusza1 brakujace dane. W głównej pętli FOR mamy cztery główne IFy, dodam ze w jednym przebiegu zawsze zostanie spełniony TYLKO jeden główny IF. Algorytm zwraca poprawne wynik, jednak dla dużej ilości danych: ile_A, ile_A1 > 10k, algorytm działa za długo. Prośba o wsparcie w optymalizacji poniższego kodu pod względem szybkości wykonywania.

 

 

Dim i As Integer
Dim j As Integer
Dim ile_A As Integer
Dim ile_A1 As Integer
Dim rach1 As String
Dim rach2 As String

ile_A = 2000
ile_A1 = 2000


For i = 2 To ile_A
    If Arkusz1.Cells(i, 1).Value <> "" And Arkusz1.Cells(i, 2).Value = "" And Arkusz1.Cells(i, 3).Value = 0 And Arkusz1.Cells(i, 14).Value = "" Then
    rach1 = Trim(Arkusz1.Cells(i, 1).Value)
        For j = 2 To ile_A1
          rach2 = Trim(Arkusz2.Cells(j, 5).Value)
          If rach1 = rach2 Then
                Arkusz1.Cells(i, 2).Value = Arkusz2.Cells(j, 6).Value
                j = ile_A1
          End If
        Next j
    End If
 
    If Arkusz1.Cells(i, 6).Value <> "" And Arkusz1.Cells(i, 7).Value = "" And Arkusz1.Cells(i, 8).Value = 0 And Arkusz1.Cells(i, 14).Value = "" Then
    rach1 = Trim(Arkusz1.Cells(i, 6).Value)
        For j = 2 To ile_A1
          rach2 = Trim(Arkusz2.Cells(j, 5).Value)
          If rach1 = rach2 Then
                Arkusz1.Cells(i, 7).Value = Arkusz2.Cells(j, 6).Value
                j = ile_A1
          End If
        Next j
    End If

    If Arkusz1.Cells(i, 1).Value = "" And Arkusz1.Cells(i, 2).Value <> "" And Arkusz1.Cells(i, 3).Value = 0 And Arkusz1.Cells(i, 14).Value = "" Then
    rach1 = Trim(Arkusz1.Cells(i, 2).Value)
        For j = 2 To ile_A1
          rach2 = Trim(Arkusz2.Cells(j, 6).Value)
          If rach1 = rach2 Then
                Arkusz1.Cells(i, 1).Value = Arkusz2.Cells(j, 5).Value
                j = ile_A1
          End If
        Next j
    End If

 
    If Arkusz1.Cells(i, 6).Value = "" And Arkusz1.Cells(i, 7).Value <> "" And Arkusz1.Cells(i, 8).Value = 0 And Arkusz1.Cells(i, 14).Value = "" Then
    rach1 = Trim(Arkusz1.Cells(i, 7).Value)
        For j = 2 To ile_A1
          rach2 = Trim(Arkusz2.Cells(j, 6).Value)
          If rach1 = rach2 Then
               Arkusz1.Cells(i, 6).Value = Arkusz2.Cells(j, 5).Value
               j = ile_A1
          End If
        Next j
    End If
Next i

 

Answer 1

<Nie analizowałem całego kodu.>

 

Przed wywołaniem funkcji z algorytmem dodaj:

Application.ScreenUpdating = False

...po wykonaniu zmień wartość na true:

Application.ScreenUpdating = True

https://msdn.microsoft.com/en-us/vba/excel-vba/articles/application-screenupdating-property-excel

W głównej pętli FOR mamy cztery główne IFy, dodam ze w jednym przebiegu zawsze zostanie spełniony TYLKO jeden główny IF.

Użyj Else If.

ile_A = 2000
ile_A1 = 2000

Nie ustawiaj ilości wierszy na sztywno, bo algorytm albo będzie wykonywał te 2000 przejść dla dowolnego zestawu danych (nawet, jeśli będą to 2 wiersze), albo wywali overflow po ostatnim wierszu (co może być problematyczne, jeżeli użyjesz ustawisz ScreenUpdating na false - wtedy algorytm nie wykona się do końca i na końcu nie zmieni tej wartości na true). Dodaj funkcję, która sprawdzi, ile jest wierszy w arkuszu.

Comments

Ogólnie nie przesłałem całego kodu tylko fragment, oczywiście mam ScreenUpdating false/true i mam część kodu liczącą ilość wierszy w Arkusz1 i Arkusz2. Tutaj dla przykładu wpisalem 2k.