VBA中的VLOOKUP

Sub 优化()
t = Timer
Dim i, j, k, m
Dim arr()
Dim arr2
Dim Rng As Object, S2 As Object
Dim R2, R3 As Long
Application.ScreenUpdating = False '停止更新屏幕
'清除原订单状态
Set S2 = Sheet2
R2 = S2.UsedRange.Rows.Count
For i = 20 To 83 Step 9
If Rng Is Nothing Then
Set Rng = S2.Range(S2.Cells(2, i), S2.Cells(R2, i))
Else
Set Rng = Union(Rng, S2.Range(S2.Cells(2, i), S2.Cells(R2, i)))
End If
Next
Rng.ClearContents
Set d = CreateObject("scripting.dictionary") '建立字典
Sheet6.Select
arr() = Sheet6.Range("a1:b" & Sheet6.Range("a1048576").End(xlUp).Row)
For i = 1 To Sheet6.Range("a1048576").End(xlUp).Row
d(arr(i, 1)) = arr(i, 2)
Next
R2 = Sheet2.UsedRange.Rows.Count
R3 = Sheet3.UsedRange.Rows.Count
k = 0
Sheet2.Select '匹配年度
For m = 1 To 8
arr2 = Range(Cells(1, 19 + k), Cells(R2, 19 + k)).Value
ReDim arr3(2 To R2, 1 To 1)
For j = 2 To R2
If d.exists(arr2(j, 1)) Then '提出字典中内容，进行比对
arr3(j, 1) = d(arr2(j, 1))
End If
Next
Cells(2, 20 + k).Resize(R2 - 1, 1).Value = arr3()
k = k + 9
Next
Sheet3.Select '匹配结转
Sheet3.Range("p1:p" & Sheet3.Range("g1048576").End(xlUp).Row).ClearContents
Sheet3.Range("h1:h" & Sheet3.Range("g1048576").End(xlUp).Row).Copy
Sheet3.Range ("p1")
Sheet3.Range("h1:h" & Sheet3.Range("g1048576").End(xlUp).Row).ClearContents
Sheet3.Range("h1") = Sheet6.Name
arr2 = Range(Cells(1, 7), Cells(R3, 7)).Value
ReDim arr3(2 To R3, 1 To 1)
For j = 2 To R3
If d.exists(arr2(j, 1)) Then '提出字典中内容，进行比对
arr3(j, 1) = d(arr2(j, 1))
End If
Next
Cells(2, 8).Resize(R3 - 1, 1).Value = arr3
MsgBox Format(Timer - t, "0.000000")
Application.ScreenUpdating = True '开启更新屏幕End Sub
End Sub

这是网络大神优化之前的

Sub 搞事情()
t = Timer
Dim i, j, k, m
Dim arr()

'清除原订单状态
Sheet2.Range("t2:t" & Sheet2.Range("t1048576").End(xlUp).Row).ClearContents
Sheet2.Range("ac2:ac" & Sheet2.Range("ac1048576").End(xlUp).Row).ClearContents
Sheet2.Range("al2:al" & Sheet2.Range("al1048576").End(xlUp).Row).ClearContents
Sheet2.Range("au2:au" & Sheet2.Range("au1048576").End(xlUp).Row).ClearContents
Sheet2.Range("bd2:bd" & Sheet2.Range("bd1048576").End(xlUp).Row).ClearContents
Sheet2.Range("bm2:bm" & Sheet2.Range("bm1048576").End(xlUp).Row).ClearContents
Sheet2.Range("bv2:bv" & Sheet2.Range("bv1048576").End(xlUp).Row).ClearContents
Sheet2.Range("ce2:ce" & Sheet2.Range("ce1048576").End(xlUp).Row).ClearContents

Set d = CreateObject("scripting.dictionary") '建立字典
Sheet6.Select
arr() = Sheet6.Range("a1:b" & Sheet6.Range("a1048576").End(xlUp).Row)
For i = 1 To Sheet6.Range("a1048576").End(xlUp).Row
d(arr(i, 1)) = arr(i, 2)
Next

Sheet2.Select '匹配年度
For m = 1 To 8
    For j = 1 To Sheet2.Range("a1048576").End(xlUp).Row
    If d.exists(Cells(j, 19 + k).Value) Then '提出字典中内容，进行比对
    Cells(j, 20 + k) = d(Cells(j, 19 + k).Value)
    End If
    Next
    k = k + 9
Next

Sheet3.Select '匹配结转
Sheet3.Range("p1:p" & Sheet2.Range("p1048576").End(xlUp).Row).ClearContents
Sheet3.Range("h1:h" & Sheet2.Range("p1048576").End(xlUp).Row).Copy Sheet3.Range("p1")
Sheet3.Range("h1:h" & Sheet2.Range("p1048576").End(xlUp).Row).ClearContents
Sheet3.Range("h1") = Sheet6.Name

For j = 1 To Sheet3.Range("g1048576").End(xlUp).Row
If d.exists(Cells(j, 7).Value) Then '提出字典中内容，进行比对
Cells(j, 8) = d(Cells(j, 7).Value)
End If
Next

MsgBox Format(Timer - t, "0.000000")
End Sub

来源网络，仅供学习