请求完善VBA批量XLOOKUP更新主供应商价目表代码

背景与需求 #

我正在开发一款Excel工具，用于将多格式供应商价目表整合为统一格式的主表。现有VBA代码仅能处理标记为NEW的条目（新增主表中不存在的记录），需要补充代码实现标记为UPDATE的价格变更条目更新功能。此前尝试编写更新循环时出现死循环，求助完善代码。

更新规则说明 #

• 匹配逻辑：源表D列（唯一标识）匹配目标表A列
• 字段更新映射：
  • 源表E列 → 目标表B列
  • 源表K列 → 目标表H列
  • 源表L列 → 目标表I列
  • 源表M列 → 目标表J列
  • 源表N列 → 目标表K列

现有VBA代码 #

Option Explicit

Sub UpdateMasterSupplier()
    
    Const PROC_TITLE As String = "Update Master Supplier"
    Const FIRST_COLUMN As Long = 2
    Const COLUMNS_COUNT As Long = 2 ' 15 in your case according to comments
    
    Dim sws As Worksheet: Set sws = MapAndValidation
    Dim slo As ListObject: Set slo = sws.ListObjects("MAV_Table")
    
    Dim srg As Range:
    
    With slo
        If .ShowAutoFilter Then
            If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        End If
        .Range.AutoFilter Field:=1, Criteria1:="New"
        With .DataBodyRange.Columns(FIRST_COLUMN).Resize(, COLUMNS_COUNT)
            On Error Resume Next
                Set srg = .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        .AutoFilter.ShowAllData
    End With
    
    If srg Is Nothing Then
        MsgBox "No matching data found.", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    Dim dws As Worksheet: Set dws = MasterSupplierFile
    Dim dlo As ListObject: Set dlo = dws.ListObjects("MSF_Table")
    
    Dim drrg As Range:
    
    With dlo
        If .ListRows.Count = 0 Then
            Set drrg = .HeaderRowRange.Offset(1).Resize(, COLUMNS_COUNT)
        Else
            With .Range
                Set drrg = .Resize(1, COLUMNS_COUNT).Offset(.Rows.Count)
            End With
        End If
    End With
    
    Dim sarg As Range, sarCount As Long
    
    For Each sarg In srg.Areas
        sarCount = sarg.Rows.Count
        drrg.Resize(sarCount).Value = sarg.Value
        Set drrg = drrg.Offset(sarCount)
    Next sarg
    
    MsgBox "Update complete.", vbInformation, PROC_TITLE

End Sub

内容的提问来源于stack exchange，提问作者craig crowhurst