Jak zwiększyć szybkość kodu przy użyciu struktur danych, a nie kolejnych pętli?

1

Rozwiązałem już kilka innych Application.Index z Application.WorksheetFunction.Match i skrócony czas działania od około 7-8 sekund do milisekund. Ale czuję, że wciąż jest miejsce na poprawę.

Czy powinienem użyć tablicy z Index i Match?

Kazano mi też używać Scripting.Dictionary, ale szukam kogoś, kto może pokazać, jak to zrobić od razu w tym scenariuszu. Ponieważ w mojej głowie muszę zapełnić słownik pętlą, zanim będę mógł go nawet użyć, więc nie będzie to podobne pod względem szybkości? 

'Production Quantity for Dashboard
For i = 2 To Total_rows_Prod
    For j = 2 To Total_rows_Dash
        If ThisWorkbook.Worksheets("Prod. Qty.").Cells(i, 5) = ThisWorkbook.Worksheets("Dashboard").Cells(j, 1) Then
           ThisWorkbook.Worksheets("Dashboard").Cells(j, 4) = ThisWorkbook.Worksheets("Dashboard").Cells(j, 4) + ThisWorkbook.Worksheets("Prod. Qty.").Cells(i, 31) / ThisWorkbook.Worksheets("Prod. Qty.").Cells(i, 4)
        End If
    Next j
Next i

Po wykonaniu niektórych testów wąskiego gardła, jak pokazano poniżej (czas wykonywania kodu jest pokazany w wierszu 10): enter image description here

Jednak podczas używania Index i Match podczas gdy tylko używasz 1 for-next pętla jak pokazano w poniższym kodzie: 

'Production Quantity for Dashboard
For i = 2 To Total_rows_Prod
    m = Application.Match(ThisWorkbook.Worksheets("Prod. Qty.").Cells(i, 5), ThisWorkbook.Worksheets("Dashboard").Range("A:A"), 0)
    If Not IsError(m) Then
        ThisWorkbook.Worksheets("Dashboard").Cells(Application.WorksheetFunction.Match(ThisWorkbook.Worksheets("Prod. Qty.").Cells(i, 5), ThisWorkbook.Worksheets("Dashboard").Range("A:A"), 0), 4) = ThisWorkbook.Worksheets("Dashboard").Cells(Application.WorksheetFunction.Match(ThisWorkbook.Worksheets("Prod. Qty.").Cells(i, 5), ThisWorkbook.Worksheets("Dashboard").Range("A:A"), 0), 4) + ThisWorkbook.Worksheets("Prod. Qty.").Cells(i, 31) / ThisWorkbook.Worksheets("Prod. Qty.").Cells(i, 4)
    End If
Next i

Czas pracy byłby nieistotny, jak pokazano poniżej (nadal w rzędzie 10):

enter image description here

Ostatnim razem udało mi się uruchomić wszystko Index i Match wymiana trwała 2 sekundy:

enter image description here

Ale na wolniejszym netbooku z procesorem Pentium Atom wykonanie tego samego kodu zajmuje 26 sekund. Zastanawiam się, czy istnieje sposób na obniżenie tego o 26 sekund.

Wszelkie ulepszenia, które pozwoliłyby optymalnie zminimalizować czas, byłyby świetne. Biorąc pod uwagę słowniki, ale nie mam pojęcia, jak je zastosować, jest Key i Value parametr dla .Add w mojej głowie wymaga 2 for-next pętle, aby zrobić to samo?

microsoft-excel vba Pherdindy
źródło
Nie jestem pewien, dlaczego tak założyłeś Index i Match to najlepszy sposób na to. Zapisz odpowiednie klucze z arkusza, który chcesz dopasować w Scripting.Dictionary, a następnie użyj .Exists jak będziesz przechodził przez drugą. Próba napisania VBA w taki sposób, jakby była to funkcja Excela, zazwyczaj nie jest sposobem na uzyskanie najlepszej wydajności.
Comintern
@Comintern dzięki właśnie zrobiłem to na podstawie moich testów i był to jedyny sposób, w jaki wiedziałem, jak to zrobić
Pherdindy
@Comintern Zastanawiam się, czy zaludnię Scripting.Dictionary z keys nie muszę biegać for-next pętla to zrobić? Wtedy będę musiał uruchomić inny for-next pętla, aby sprawdzić słownik .Exists? Podczas, gdy Index i Match powinien potrzebować tylko jednego for-next pętla do zrobienia całości. Pod względem szybkości, która jest szybsza?
Pherdindy
Nadal musisz uruchomić pętlę for-next, ale nie są już zagnieżdżone. To, co robisz, polega na tym, że a Dictionary przegląda zamiast przeszukiwać całą kolekcję. Spojrzeć na ta odpowiedź na CR aby lepiej zrozumieć, o czym mówię.
Comintern

Odpowiedzi:

1

Ogólnie rzecz biorąc, najbardziej czasochłonna część kodu VBA polega na czytaniu i zapisywaniu wartości z / do arkuszy. Powinieneś to zmniejszyć tak bardzo, jak możesz.

Najprostszym sposobem zmniejszenia takich operacji jest odczyt danych wejściowych do tablic, manipulowanie nimi w razie potrzeby, a następnie zapisanie danych wyjściowych.
Możesz przeczytać więcej o tym np. tutaj: http://www.cpearson.com/Excel/ArraysAndRanges.aspx

Twój zaktualizowany kod wyglądałby mniej więcej tak: 

Dim arr_prodQty5 As Variant
Dim arr_DashBoard1 As Variant
Dim arr_DashBoard4 As Variant
Dim arr_prodQty31 As Variant
Dim arr_prodQty4 As Variant

arr_prodQty5 = ThisWorkbook.Worksheets("Prod. Qty.").Range(Cells(2, 5), Cells(Total_rows_Prod, 5))
arr_prodQty4 = ThisWorkbook.Worksheets("Prod. Qty.").Range(Cells(2, 4), Cells(Total_rows_Prod, 4))
arr_prodQty31 = ThisWorkbook.Worksheets("Prod. Qty.").Range(Cells(2, 5), Cells(Total_rows_Prod, 5))
arr_DashBoard1 = ThisWorkbook.Worksheets("Dashboard").Range(Cells(2, 1), Cells(total_rows_dash, 1))
arr_DashBoard4 = ThisWorkbook.Worksheets("Dashboard").Range(Cells(2, 4), Cells(total_rows_dash, 4))

For i = 2 To Total_rows_Prod
    For j = 2 To total_rows_dash
        If arr_prodQty5(i, 1) = arr_DashBoard1(j, 1) Then
           arr_DashBoard4(j, 1) = arr_DashBoard4(j, 1) + arr_prodQty31(i, 1) / arr_prodQty4(i, 1)
        End If
    Next j
Next i

ThisWorkbook.Worksheets("Dashboard").Range(Cells(2, 4), Cells(total_rows_dash, 4)) = arr_DashBoard4

(Nie mam twoich danych, więc nie mogłem sprawdzić, czy rzeczywiście działa, najprawdopodobniej będziesz musiał naprawić błąd przed uruchomieniem)

Używanie słownika zamiast tablic to po prostu bardziej wyrafinowany sposób na osiągnięcie tego samego wyniku.

Máté Juhász
źródło