VBA需求：基于主表数据批量删除多Excel文件行（替代逐行判断）

核心修改思路 #

• 用字典存储主表条件：将主表中需要匹配的日期（A列）和代码（C列）组合成唯一键，存入字典以实现快速查找
• 统一数据格式：将日期转换为一致的字符串格式，避免因数据类型差异导致匹配失败
• 批量匹配删除：遍历目标文件的每一行，检查该行的日期+代码组合是否存在于字典中，存在则删除该行

修改后的完整代码 #

文件夹遍历主过程（无需修改） #

Sub LoopAllExcelFilesInFolder()
'PURPOSE: 遍历指定文件夹内所有Excel文件并执行删除行操作
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'优化宏运行速度
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'让用户选择目标文件夹
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "选择目标文件夹"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'取消选择的情况
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'目标文件扩展名（需包含通配符"*"）
  myExtension = "*.xls*"

'带扩展名的目标路径
  myFile = Dir(myPath & myExtension)

'遍历文件夹内的每个Excel文件
  Do While myFile <> ""
    '打开工作簿并赋值给变量
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    '确保工作簿已打开再执行后续代码
      DoEvents
    
    '调用删除行的子过程
      Call DeleteRowsBasedonCellValue
    
    '保存并关闭工作簿
      wb.Close SaveChanges:=True
      
    '确保工作簿已关闭再执行后续代码
      DoEvents

    '获取下一个文件名
      myFile = Dir
  Loop

'任务完成提示
  MsgBox "任务执行完毕！"

ResetSettings:
  '恢复系统设置
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

基于主表删除行的子过程（核心修改） #

Sub DeleteRowsBasedonCellValue()
    Dim wsTarget As Worksheet
    Dim wsMaster As Worksheet
    Dim lastRowTarget As Long, lastRowMaster As Long
    Dim i As Long
    Dim criteriaDict As Object
    Dim key As String
    Dim dateStr As String
    
    '指定主表（修改为你实际的主表工作表名称）
    Set wsMaster = ThisWorkbook.Sheets("Sheet1")
    '当前处理的目标工作表
    Set wsTarget = ActiveSheet
    '创建字典存储条件组合
    Set criteriaDict = CreateObject("Scripting.Dictionary")
    
    '读取主表的条件数据（假设主表第1行是表头，从第2行开始读取）
    lastRowMaster = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRowMaster
        '将日期转换为统一字符串格式，避免数据类型不匹配
        dateStr = Format(wsMaster.Cells(i, "A").Value, "dd.mm.yy")
        '组合日期和代码作为字典的唯一键
        key = dateStr & "|" & wsMaster.Cells(i, "C").Value
        If Not criteriaDict.Exists(key) Then
            criteriaDict.Add key, True
        End If
    Next i
    
    '遍历目标工作表的行（从下往上，避免删除行导致索引错乱）
    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    For i = lastRowTarget To 2 Step -1 '假设目标表第1行是表头，从第2行开始检查
        dateStr = Format(wsTarget.Cells(i, "A").Value, "dd.mm.yy")
        key = dateStr & "|" & wsTarget.Cells(i, "C").Value
        '如果当前行的条件组合存在于主表，删除该行
        If criteriaDict.Exists(key) Then
            wsTarget.Rows(i).Delete
        End If
    Next i
    
    '释放对象资源
    Set criteriaDict = Nothing
    Set wsMaster = Nothing
    Set wsTarget = Nothing
End Sub

使用说明 #

• 主表准备：将需要匹配删除的日期（A列）和代码（C列）存入运行宏的工作簿的Sheet1中（可修改代码中的工作表名称），第1行作为表头
• 格式统一：确保主表和目标文件的日期格式一致，代码中已通过Format函数转换为dd.mm.yy格式，可根据实际需求调整格式字符串
• 表头处理：代码默认表头为第1行，若你的表格无表头或表头行数不同，需修改循环的起始行（i=2改为i=1）

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