[英]Vlookup Change Event in array and dictionary
我想用數組和字典制作 vba vlookup 更改事件,以便處理變得更快,因為記錄數據是 25000。 表“master”是數據源表,我將出現在交易表(“TRANS”)中的結果標記為黃色,表“trans”是交易表,我標記的黃色來自數據工作表“MASTER”的來源 我的綠色標記是鍵或唯一 ID。 如果我非常緩慢地使用公式“vlookup”所以我想要一個帶有字典和數組的 vba 代碼?
Private Sub Worksheet_Change(ByVal Target As Range)
'On Error GoTo bm_Safe_Exit
If Intersect(Target, Range("L:L")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Dim fnd As Range
Set fnd = Sheets("MASTER").Range("B:B").Find(Target, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
Target.Offset(, 2).Resize(, 1).Value = Array(fnd.Offset(, 3))
Target.Offset(, 4).Resize(, 1).Value = Array(fnd.Offset(, 6))
Target.Offset(, 6).Resize(, 1).Value = Array(fnd.Offset(, 8))
Target.Offset(, 7).Resize(, 1).Value = Array(fnd.Offset(, 4))
End If
'bm_Safe_Exit:
Application.EnableEvents = True
End Sub
這會更快:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range, m, wsM As Worksheet, arr
Set rng = Application.Intersect(Target, Me.Range("L:L"))
If rng Is Nothing Then Exit Sub
Set wsM = ThisWorkbook.Worksheets("MASTER")
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
For Each c In rng.Cells 'process all changed cells in ColB
m = Application.Match(c.Value, wsM.Range("B:B"), 0) 'match much faster than Find()
If Not IsError(m) Then
arr = wsM.Cells(m, "E").Resize(1, 6) 'one read
c.Offset(0, 2).Value = arr(1, 1)
c.Offset(0, 4).Value = arr(1, 4)
c.Offset(0, 6).Resize(1, 2).Value = Array(arr(1, 6), arr(1, 2))
End If
Next c
bm_Safe_Exit:
Application.EnableEvents = True 'be sure to re-enable events
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.