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