สมการการค้นหาอ้างอิง VBA

ฉันจะโหลดทั้งหมดลงในอาร์เรย์หน่วยความจำแล้ววนซ้ำ

Sub kjlk()


Dim qty As Worksheet
Dim Imonth As Integer, IImonth As Integer
Dim lrow As Long
Dim summary1 As Worksheet

'assign the variables
Set qty = Worksheets("Sheet1")
Set summary1 = Worksheets("Sheet2")

Imonth = 20
IImonth = 21

lrow = 20

Dim IMArr As Variant
Dim IIMarr As Variant
Dim lkupArr As Variant

IMArr = Intersect(qty.Columns(Imonth), qty.UsedRange).Value
IIMarr = Intersect(qty.Columns(IImonth), qty.UsedRange).Value
lkupArr = Intersect(qty.Columns(1), qty.UsedRange).Value

Dim InArr As Variant
Dim OutArr As Variant



With summary1
    InArr = .Range("A3:A" & lrow).Value
    ReDim OutArr(1 To UBound(InArr, 1), 1 To 1)
    Dim i As Long
    For i = 1 To UBound(InArr, 1)
        Dim mtch As Long
        mtch = WhereContains(lkupArr, InArr(i, 1))
        If mtch > -1 Then
            OutArr(i, 1) = IMArr(mtch, 1) - IIMarr(mtch, 1)
        Else
            OutArr(i, 1) = vbNullString
        End If
    Next i
   .Range("B3:B" & lrow).Value= OutArr
End With
End Sub

Function WhereContains(arr, v) As Long
Dim rv As Long, i As Long
    rv = -1
    For i = LBound(arr) To UBound(arr)
        If arr(i, 1) = v Then
            rv = i
            Exit For
        End If
    Next i
    WhereContains = rv
End Function