Sub需要10分鐘才能運行，有時會崩潰，需要幫助簡化它-有解無憂

我有一個代碼可以將 100K 的庫存分類到作業簿中的 9 張紙上。該代碼有一些錯誤，但總體上作業正常。問題是運行大約需要 10 分鐘，并且取決于計算機是否會使緩沖區過載并崩潰 excel。我已經重寫了幾次，現在我正在尋求幫助以簡化它。代碼如下，任何建議都非常感謝。該代碼獲取一張包含 100K 行庫存的作業表，在適當的作業表上找到它的位置并計算數字。有 9 張紙，有 3 種不同的格式。

Sub SortTMS()

Application.ScreenUpdating = False
Application.Calculation = xlManual

Dim LDate As Date
Dim Slot As String
Dim SlotRange As Range
Dim SlotAddress1 As Range
Dim SlotAddress2 As Range
Dim SlotLookUp1 As Range
Dim SlotLookUp2 As Range

Dim SR1 As String, SR2 As String, SR3 As String, SR4 As String, SR5 As String
Dim SR6 As String, SR7 As String, SR8 As String, SR9 As String, SR10 As String
Dim SR11 As String, SR12 As String, SR13 As String, SR14 As String, SR15 As String
Dim SR16 As String, SR17 As String, SR18 As String, SR19 As String, SR20 As String
Dim SR21 As String

Dim SlotWs1 As Worksheet, SlotWs2 As Worksheet, SlotWs3 As Worksheet, SlotWs4 As Worksheet
Dim SlotWs5 As Worksheet, SlotWs6 As Worksheet, SlotWs7 As Worksheet, TMSWs As Worksheet

Set SlotWs1 = ThisWorkbook.Worksheets("A Mod")
Set SlotWs2 = ThisWorkbook.Worksheets("B Mod")
Set SlotWs3 = ThisWorkbook.Worksheets("C Mod")
Set SlotWs4 = ThisWorkbook.Worksheets("D Mod")
Set SlotWs5 = ThisWorkbook.Worksheets("E Mod")
Set SlotWs6 = ThisWorkbook.Worksheets("F Mod")
Set SlotWs7 = ThisWorkbook.Worksheets("Offline")
Set SlotWs8 = ThisWorkbook.Worksheets("DPAL")
Set SlotWs9 = ThisWorkbook.Worksheets("NC DPAL")
Set TMSWs = ThisWorkbook.Sheets("TMS Data")

SR1 = "A5:A3100"            ''      1st high                alpha high dpal                 offline A3500
SR2 = "E5:E3100"            ''                              alpha low dpal
SR3 = "G5:G3100"            ''      1st low                                                 offline A3900
SR4 = "J5:J3100"            ''                              bravo high dpal
SR5 = "M5:M3100"            ''      2nd high                                                offline B3100
SR6 = "N5:N3100"            ''                              bravo low dpal
SR7 = "S5:S3100"            ''      2nd low                 charlie high dpal               Aerosol Q0001
SR8 = "W5:W3100"            ''                              charlie low dpal
SR9 = "Y5:Y3100"            ''      3rd high
SR10 = "AB5:AB3100"         ''                              delta high dpal
SR11 = "AE5:AE3100"         ''      3rd low
SR12 = "AF5:AF3100"         ''                              delta low dpal
SR13 = "AK5:AK3100"         ''      1st high non com        echo high dpal
SR14 = "AO5:AO3100"         ''                              echo low dpal
SR15 = "AQ5:AQ3100"         ''      1st low non com
SR16 = "AT5:AT3100"         ''                              fox high dpal
SR17 = "AW5:AW3100"         ''      2nd high non com
SR18 = "AX5:AX3100"         ''                              fox high dpal
SR19 = "BC5:BC3100"         ''      2nd low non com
SR20 = "BI5:BI3100"         ''      3rd high non com
SR21 = "BO5:BO3100"         ''      3rd low non com

SlotWs1.Range("aclear").ClearContents
SlotWs2.Range("bclear").ClearContents
SlotWs3.Range("cclear").ClearContents
SlotWs4.Range("dclear").ClearContents
SlotWs5.Range("eclear").ClearContents
SlotWs6.Range("fclear").ClearContents
SlotWs7.Range("offclear").ClearContents
SlotWs7.Range("DPALclear").ClearContents
SlotWs7.Range("NCDPALClear").ClearContents
        

Set SlotRange = TMSWs.Range("I:I")
        
    For Each cl In SlotRange
     
On Error GoTo ErrHandler
    
        Slot = cl.Value
        LDate = TMSWs.Range(cl.Address).Offset(0, -5).Value
        
        Select Case Slot
            Case "A0001" To "A0010"                                 'Alpha 1st low non com
                Set SlotLookUp1 = SlotWs1.Range(SR15)
            Case "A0011" To "A0499"                                 'Alpha 1st low
                Set SlotLookUp1 = SlotWs1.Range(SR3)
            Case "A0500" To "A0633"                                 'Alpha 1st high
                Set SlotLookUp1 = SlotWs1.Range(SR1)
            Case "A0634" To "A0999"                                 'Alpha 1st high non com
                Set SlotLookUp1 = SlotWs1.Range(SR13)
            Case "A1001" To "A1012"                                 'Alpha 2nd low non com
                Set SlotLookUp1 = SlotWs1.Range(SR19)
            Case "A1013" To "A1499"                                 'Alpha 2nd low
                Set SlotLookUp1 = SlotWs1.Range(SR7)
            Case "A1500" To "A1752"                                 'Alpha 2nd high
                Set SlotLookUp1 = SlotWs1.Range(SR5)
            Case "A1753" To "A1999"                                 'Alpha 2nd high non com
                Set SlotLookUp1 = SlotWs1.Range(SR17)
            Case "A2001" To "A2020"                                 'Alpha 3rd low non com
                Set SlotLookUp1 = SlotWs1.Range(SR21)
            Case "A2021" To "A2499"                                 'Alpha 3rd low
                Set SlotLookUp1 = SlotWs1.Range(SR11)
            Case "A2500" To "A2745"                                 'Alpha 3rd high
                Set SlotLookUp1 = SlotWs1.Range(SR9)
            Case "A2746" To "A2999"                                 'Alpha 3rd high non com
                Set SlotLookUp1 = SlotWs1.Range(SR20)
                
            Case "B0001" To "B0010"                                 'Bravo 1st low non com
                Set SlotLookUp1 = SlotWs2.Range(SR15)
            Case "B0011" To "B0499"                                 'Bravo 1st low
                Set SlotLookUp1 = SlotWs2.Range(SR3)
            Case "B0500" To "B0632"                                 'Bravo 1st high
                Set SlotLookUp1 = SlotWs2.Range(SR1)
            Case "B0633" To "B0999"                                 'Bravo 1st high non com
                Set SlotLookUp1 = SlotWs2.Range(SR13)
            Case "B1000" To "B1012"                                 'Bravo 2nd low non com
                Set SlotLookUp1 = SlotWs2.Range(SR19)
            Case "B1013" To "B1499"                                 'Bravo 2nd low
                Set SlotLookUp1 = SlotWs2.Range(SR7)
            Case "B1500" To "B1760"                                 'Bravo 2nd high
                Set SlotLookUp1 = SlotWs2.Range(SR5)
            Case "B1761" To "B1999"                                 'Bravo 2nd high non com
                Set SlotLookUp1 = SlotWs2.Range(SR17)
            Case "B2000" To "B2020"                                 'Bravo 3rd low non com
                Set SlotLookUp1 = SlotWs2.Range(SR21)
            Case "B2021" To "B2499"                                 'Bravo 3rd low
                Set SlotLookUp1 = SlotWs2.Range(SR11)
            Case "B2500" To "B2753"                                 'Bravo 3rd high
                Set SlotLookUp1 = SlotWs2.Range(SR9)
            Case "B2754" To "B2999"                                 'Bravo 3rd high non com
                Set SlotLookUp1 = SlotWs2.Range(SR20)
                
            Case "C0001" To "C0012"                                 'Charlie 1st low non com
                Set SlotLookUp1 = SlotWs3.Range(SR15)
            Case "C0013" To "C0499"                                 'Charlie 1st low
                Set SlotLookUp1 = SlotWs3.Range(SR3)
            Case "C0500" To "C0635"                                 'Charlie 1st high
                Set SlotLookUp1 = SlotWs3.Range(SR1)
            Case "C0636" To "C0999"                                 'Charlie 1st high non com
                Set SlotLookUp1 = SlotWs3.Range(SR13)
            Case "C1000" To "C1016"                                 'Charlie 2nd low non com
                Set SlotLookUp1 = SlotWs3.Range(SR19)
            Case "C1017" To "C1499"                                 'Charlie 2nd low
                Set SlotLookUp1 = SlotWs3.Range(SR7)
            Case "C1500" To "C1748"                                 'Charlie 2nd high
                Set SlotLookUp1 = SlotWs3.Range(SR5)
            Case "C1749" To "C1999"                                 'Charlie 2nd high non com
                Set SlotLookUp1 = SlotWs3.Range(SR17)
            Case "C2000" To "C2024"                                 'Charlie 3rd low non com
                Set SlotLookUp1 = SlotWs3.Range(SR21)
            Case "C2025" To "C2499"                                 'Charlie 3rd low
                Set SlotLookUp1 = SlotWs3.Range(SR11)
            Case "C2500" To "C2749"                                 'Charlie 3rd high
                Set SlotLookUp1 = SlotWs3.Range(SR9)
            Case "C2750" To "C2999"                                 'Charlie 3rd high non com
                Set SlotLookUp1 = SlotWs3.Range(SR20)
                
            Case "D0001" To "D0009"                                 'Delta 1st low non com
                Set SlotLookUp1 = SlotWs4.Range(SR15)
            Case "D0010" To "D0499"                                 'Delta 1st low
                Set SlotLookUp1 = SlotWs4.Range(SR3)
            Case "D0500" To "D0634"                                 'Delta 1st high
                Set SlotLookUp1 = SlotWs4.Range(SR1)
            Case "D0635" To "D0999"                                 'Delta 1st high non com
                Set SlotLookUp1 = SlotWs4.Range(SR13)
            Case "D1000" To "D1014"                                 'Delta 2nd low non com
                Set SlotLookUp1 = SlotWs4.Range(SR19)
            Case "D1015" To "D1499"                                 'Delta 2nd low
                Set SlotLookUp1 = SlotWs4.Range(SR7)
            Case "D1500" To "D1753"                                 'Delta 2nd high
                Set SlotLookUp1 = SlotWs4.Range(SR5)
            Case "D1754" To "D1999"                                 'Delta 2nd high non com
                Set SlotLookUp1 = SlotWs4.Range(SR17)
            Case "D2000" To "D2020"                                 'Delta 3rd low non com
                Set SlotLookUp1 = SlotWs4.Range(SR21)
            Case "D2021" To "D2499"                                 'Delta 3rd low
                Set SlotLookUp1 = SlotWs4.Range(SR11)
            Case "D2500" To "D2750"                                 'Delta 3rd high
                Set SlotLookUp1 = SlotWs4.Range(SR9)
            Case "D2751" To "D2999"                                 'Delta 3rd high non com
                Set SlotLookUp1 = SlotWs4.Range(SR20)
                
            Case "E0001" To "E0010"                                 'Echo 1st low non com
                Set SlotLookUp1 = SlotWs5.Range(SR15)
            Case "E0011" To "E0499"                                 'Echo 1st low
                Set SlotLookUp1 = SlotWs5.Range(SR3)
            Case "E0500" To "E0638"                                 'Echo 1st high
                Set SlotLookUp1 = SlotWs5.Range(SR1)
            Case "E0639" To "E0999"                                 'Echo 1st high non com
                Set SlotLookUp1 = SlotWs5.Range(SR13)
            Case "E1000" To "E1019"                                 'Echo 2nd low non com
                Set SlotLookUp1 = SlotWs5.Range(SR19)
            Case "E1020" To "E1499"                                 'Echo 2nd low
                Set SlotLookUp1 = SlotWs5.Range(SR7)
            Case "E1500" To "E1760"                                 'Echo 2nd high
                Set SlotLookUp1 = SlotWs5.Range(SR5)
            Case "E1761" To "E1999"                                 'Echo 2nd high non com
                Set SlotLookUp1 = SlotWs5.Range(SR17)
            Case "E2000" To "E2020"                                 'Echo 3rd low non com
                Set SlotLookUp1 = SlotWs5.Range(SR21)
            Case "E2021" To "E2499"                                 'Echo 3rd low
                Set SlotLookUp1 = SlotWs5.Range(SR11)
            Case "E2500" To "E2758"                                 'Echo 3rd high
                Set SlotLookUp1 = SlotWs5.Range(SR9)
            Case "E2759" To "E2999"                                 'Echo 3rd high non com
                Set SlotLookUp1 = SlotWs5.Range(SR20)
                
            Case "F0001" To "F0053"                                 'Fox 1st low non com
                Set SlotLookUp1 = SlotWs6.Range(SR15)
            Case "F0054" To "F0499"                                 'Fox 1st low
                Set SlotLookUp1 = SlotWs6.Range(SR3)
            Case "F0500" To "F0636"                                 'Fox 1st high
                Set SlotLookUp1 = SlotWs6.Range(SR1)
            Case "F0637" To "F0999"                                 'Fox 1st high non com
                Set SlotLookUp1 = SlotWs6.Range(SR13)
            Case "F1000" To "F1106"                                 'Fox 2nd low non com
                Set SlotLookUp1 = SlotWs6.Range(SR19)
            Case "F1107" To "F1499"                                 'Fox 2nd low
                Set SlotLookUp1 = SlotWs6.Range(SR7)
            Case "F1500" To "F1757"                                 'Fox 2nd high
                Set SlotLookUp1 = SlotWs6.Range(SR5)
            Case "F1758" To "F1999"                                 'Fox 2nd high non com
                Set SlotLookUp1 = SlotWs6.Range(SR17)
            Case "F2000" To "F2018"                                 'Fox 3rd low non com
                Set SlotLookUp1 = SlotWs6.Range(SR21)
            Case "F2019" To "F2499"                                 'Fox 3rd low
                Set SlotLookUp1 = SlotWs6.Range(SR11)
            Case "F2500" To "F2749"                                 'Fox 3rd high
                Set SlotLookUp1 = SlotWs6.Range(SR9)
            Case "F2750" To "F2999"                                 'Fox 3rd high non com
                Set SlotLookUp1 = SlotWs6.Range(SR20)
                
            Case "A3500" To "A3899"                                 'Offline A3500
                Set SlotLookUp1 = SlotWs7.Range(SR1)
            Case "A3900" To "A3999"                                 'Offline A3900
                Set SlotLookUp1 = SlotWs7.Range(SR3)
            Case "B3100" To "B3499"                                 'Offline A3100
                Set SlotLookUp1 = SlotWs7.Range(SR5)
            Case "Q0001" To "Q2999"                                 'Aerosol
                Set SlotLookUp1 = SlotWs7.Range(SR7)
                
            Case "A8000" To "A9999", "I4000" To "I5999", "J4000" To "J4999", "X4000" To "X6999"             'alpha high dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "A4000" To "A7999"                                                                         'alpha low dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "C4000" To "C6999"                                                                         'bravo high dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "B4000" To "B9999", "J6000" To "J9999", "L4000" To "L7999"                                 'bravo low dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "D4000" To "D6999"                                                                         'charlie high dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "C7000" To "C9999"                                                                         'charkie low dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "E4000" To "E6999"                                                                         'delta high dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "D7000" To "D9999"                                                                         'delta low dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "F4000" To "F6999"                                                                         'echo high dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "E7000" To "E9999"                                                                         'echo low dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "G4000" To "G6999", "Q4000" To "Q7999", "T4000" To "T9999", "W4000" To "W8999"             'fox high dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
            Case "F7000" To "F9999"                                                                         'fox low dpal
                Set SlotLookUp1 = Union(SlotWs8.Range(SR1), SlotWs9.Range(SR1))
                
            Case Else
                Debug.Print Slot
                Slot = ""
            End Select
            
                If Slot = "" Then
                Else
                    If LDate >= Date Then
                    
                        With SlotLookUp1
                            Set SlotAddress1 = .Find(What:=Slot, After:=.Cells(.Cells.Count), LookIn:=xlValues, _
                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
                            Set SlotAddress2 = .Find(What:=Slot, After:=.Cells(.Cells.Count), LookIn:=xlValues, _
                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
                        End With
                        
                        SlotAddress1.Value = SlotAddress1.Value   1
                        SlotAddress2.Value = SlotAddress2.Value   1
                        
                    ElseIf LDate < Date Then
                    
                        With SlotLookUp1
                            Set SlotAddress1 = .Find(What:=Slot, After:=.Cells(.Cells.Count), LookIn:=xlValues, _
                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
                            Set SlotAddress2 = .Find(What:=Slot, After:=.Cells(.Cells.Count), LookIn:=xlValues, _
                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, 3)
                        End With
                        
                        SlotAddress1.Value = SlotAddress1.Value   1
                        SlotAddress2.Value = SlotAddress2.Value   1
                        
                    End If
                End If
                
ErrHandler:
    Debug.Print Slot
    Resume Next
    
        Next cl

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

End Sub

uj5u.com熱心網友回復：

200,000Find()次呼叫會非常慢：使用Match會快得多。

例如：

Dim oSet As Long, m, Slot, SlotLookup1, LDate
'...
'...
'...
If Len(Slot) > 0 Then
    m = Application.Match(Slot, SlotLookup1, 0) 'faster than `Find()`
    If Not IsError(m) Then                      'got a match?
        oSet = IIf(LDate >= Date, 2, 3)         'offset for second cell to be incremented
        With SlotLookup1.Cells(m)
            .Offset(0, 1).Value = .Offset(0, 1).Value   1       'increment cell values
            .Offset(0, oSet).Value = .Offset(0, oSet).Value   1
        End With
    End If
End If
'...
'...
'...

還要考慮@Tragamor 的建議，即不要回圈遍歷 I 列的所有行，這大約是實際資料行數的 10 倍

uj5u.com熱心網友回復：

考慮 https://stackoverflow.com/questions/33302962/performance-difference-between-looping-range-vs-looping-array#:~:text=Looping through an array is way faster than% 20looking through a range.&text=其中使得 looping through an,faster than through a loop.&text= more values you have, the biger the% 20差異將是。

TLDR：首先將您的 Range 分配給二維陣列，而不是直接更新和從單元格中提取。在我自己的作業表中，這將性能提高了 30 倍。對陣列執行所有計算和分配，然后將陣列分配回您的 Range。

轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/449929.html

標籤：擅长 vba

上一篇：如何根據條件邏輯將行復制并粘貼到某個起點并增加每次添加？

下一篇：特定邊框的VBA條件格式