Replace table array form with VBA memory array

My worksheet requires the following array formula in BG2.

=INDEX('Client'!O$2:O$347473,
       MATCH(1, (('Client_Cost'!D$2:D$347473='Client'!BC2)*
                 ('Client_Cost'!E$2:E$347473='Client'!BE2)), 0))

This provides a two-column match (Client_Cost! D: D for the client! BC2 And Client_Cost! E: E for the client! BE2) and returns the corresponding value from the client! O: O.

A large number of lines makes the array formula very intensive to calculate. I can deal with several hundred lines (~ 90 seconds for 500 lines), but I need results up to Client '! BG347473, and I would like them sometime this year.

I tried using Application Evaluate to return the result from the array formula to the variant array and subsequently return the array of results to the worksheet in bulk, but this is not the improvement I was hoping for. Look for alternatives.

+4
source share
1 answer

First, I would recommend developing alternative methods with a smaller data set. 5K or 10K lines will either show a noticeable improvement or not; you can always go to the original dataset as soon as you are sure that you are not in a long “Not responding” state, due to which you must fail.

A common method for removing an array from this style of Formula 1 is the helper column, which combines the two values ​​from column D and E in the Client_Cost sheet into one separation value. For example, in Client_Cost! Z2 as

=CONCATENATE(Client_Cost!D2, "|", Client_Cost!E2)

Fill up to Client_Cost! Z347473 only takes a second or two.

, INDEX/MATCH ! BC2 Client!! BE2. ! BG2 as,

=INDEX(Client!O$2:O$347473,
   MATCH(CONCATENATE(Client!BC2, "|", Client!BE2), 
         Client_Cost'!Z$2:Z$347473, 0))

1 , 51 350K. , ~ 17,5 , .

VBA Scripting.Dictionary. , , (, ).

Sub JR_CSE_in_Array()
    Dim olr As Long, rws As Long, JR_Count As Long, JR_Values As Variant
    Dim v As Long, vTMP As Variant, vTMPs As Variant, dVALs As Object

    Debug.Print Timer
    Set dVALs = CreateObject("Scripting.Dictionary")

    'get some dimensions to the various data ranges
    With Worksheets("Client_Cost")
        'only use as many rows as absolutely necessary
        olr = Application.Min(.Cells(Rows.Count, "D").End(xlUp).Row, _
                              .Cells(Rows.Count, "E").End(xlUp).Row)
        'store D & E
        vTMPs = .Range(.Cells(2, 4), .Cells(olr, 5)).Value2

    End With
    With Worksheets("Client")
        rws = Application.Min(.Cells(Rows.Count, "BC").End(xlUp).Row, _
                              .Cells(Rows.Count, "BE").End(xlUp).Row, _
                              UBound(vTMPs, 1))
        'override the above statement for sampling
        'rws = 5000

        'building the Dictionary object takes a fair bit of time but it is worth it
        vTMP = .Range(.Cells(2, 15), .Cells(olr, 15)).Value2
        For v = LBound(vTMPs, 1) To UBound(vTMPs, 1)
            If Not dVALs.Exists(Join(Array(vTMPs(v, 1), vTMPs(v, 2)), ChrW(8203))) Then _
                dVALs.Add Key:=Join(Array(vTMPs(v, 1), vTMPs(v, 2)), ChrW(8203)), Item:=vTMP(v, 1)
        Next v

        'store BC and BE
        vTMPs = .Range(.Cells(2, 55), .Cells(olr, 57)).Value2
    End With

    ReDim JR_Values(1 To rws, 1 To 1)   'force a two-dimension, one-based index on the array
    'Debug.Print LBound(JR_Values) & ":" & UBound(JR_Values)

    For JR_Count = LBound(JR_Values, 1) To UBound(JR_Values, 1) Step 1
        If dVALs.Exists(Join(Array(vTMPs(JR_Count, 1), vTMPs(JR_Count, 3)), ChrW(8203))) Then
            JR_Values(JR_Count, 1) = dVALs.Item(Join(Array(vTMPs(JR_Count, 1), vTMPs(JR_Count, 3)), ChrW(8203)))
        End If
    Next JR_Count

    With Worksheets("Client")
        .Range("BG2").Resize(UBound(JR_Values), 1) = JR_Values
    End With

    'Debug.Print dVALs.Count
    dVALs.RemoveAll: Set dVALs = Nothing
    Debug.Print Timer
End Sub

( ) 45,72 . , 13,4 , , , .

Multi_Col_Match_Array_in_Memory

, Scripting.Dictionary . , , . .

, . SQL SELECT INNER JOIN , SELECT , , , - .

Excel , . (.XLSB) ¹/₃ .XLSX .XLSM. , .

.XLSB . , , .


¹ Ctrl + Shift + Enter↵. , . , . , . . .

+3

Source: https://habr.com/ru/post/1619052/


All Articles