简体   繁体   English

数组和字典中的 Vlookup 更改事件

[英]Vlookup Change Event in array and dictionary

I want to make vba vlookup change event with array and dictionary so that the process becomes fast because the record data is twenty-five thousand.我想用数组和字典制作 vba vlookup 更改事件,以便处理变得更快,因为记录数据是 25000。 Sheet "master" is the data source sheet and I mark the yellow color of the result that appears in the transaction sheet ("TRANS") and the sheet "trans" is the transaction sheet and which I mark the yellow color comes from the data source of the sheet "MASTER" My green marking is key or unique id.表“master”是数据源表,我将出现在交易表(“TRANS”)中的结果标记为黄色,表“trans”是交易表,我标记的黄色来自数据工作表“MASTER”的来源 我的绿色标记是键或唯一 ID。 if I use the formula "vlookup" very slowly So I want a vba code with dictionary & array?如果我非常缓慢地使用公式“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

纯粹的“大师” 表“反”

This will be faster:这会更快:

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM