VBA AdvancedFilter报错1004及Excel年月维度防重问题求助

一、筛选报错（Error 1004）问题 #

错误原因分析

触发Error 1004的核心问题：

1. 复制目标区域列数不匹配：AdvancedFilter要求复制目标区域的列数必须和数据源（erng）列数完全一致，当前代码指定的E:S固定列数若与erng列数不符，直接报错。
2. 无匹配数据时执行删除操作：如果筛选后没有复制任何数据，删除指定行的操作会因空行触发错误。
3. CurrentRegion范围可能异常：若数据源工作表A3开始的区域存在空行/空列，CurrentRegion会包含无效范围，导致筛选逻辑出错。

修正代码

Sub myFilter()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim crng As Range
    Dim lastrow As Long
    Dim ews As Worksheet
    Dim erng As Range
    Dim i As Integer
    Dim copyTarget As Range
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Monthly Summary")
    
    ' 清空历史筛选结果
    ws.Range("E5", ws.Cells(ws.Rows.Count, "E").End(xlUp).End(xlToRight)).Clear
    
    ' 定义条件区域（确保包含表头和筛选条件）
    Set crng = ws.Range("B4").CurrentRegion
    
    For i = 3 To wb.Worksheets.Count
        Set ews = wb.Worksheets(i)
        Set erng = ews.Range("A3").CurrentRegion
        
        ' 仅当数据源有数据时执行筛选
        If erng.Rows.Count > 1 Then
            lastrow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row + 1
            ' 匹配数据源列数设置复制目标区域
            Set copyTarget = ws.Cells(lastrow, "E").Resize(1, erng.Columns.Count)
            
            ' 捕获无匹配数据的情况，避免报错
            On Error Resume Next
            erng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=crng, CopyToRange:=copyTarget
            On Error GoTo 0
            
            ' 仅当有数据复制时执行删除操作
            If Not IsEmpty(copyTarget) Then
                ws.Rows(lastrow).Delete Shift:=xlUp
            End If
        End If
    Next i
End Sub

注意事项

• 确保条件区域（B4开始）的表头与所有数据源工作表的表头完全一致（大小写、空格均需匹配）。
• 检查数据源工作表A3开始的区域，避免空表头或无效空行干扰CurrentRegion范围。

二、按年月维度防止重复保存问题 #

实现逻辑

保存前先校验当前编辑的年月数据是否已存在，存在则提示覆盖，不存在则新增，从根源避免重复。

示例代码（整合到保存按钮）

Sub SaveData()
    Dim wb As Workbook
    Dim inputWs As Worksheet
    Dim targetWs As Worksheet
    Dim currentYM As String
    Dim foundRow As Range
    Dim lastRow As Long
    
    Set wb = ThisWorkbook
    Set inputWs = wb.Worksheets("DataEntry") ' 替换为实际录入工作表名
    Set targetWs = wb.Worksheets("Monthly Summary")
    
    ' 统一年月格式（比如"2024-05"），确保匹配准确
    currentYM = Format(inputWs.Range("B2").Value, "yyyy-mm")
    
    ' 在目标表年月列（假设为E列）查找重复
    Set foundRow = targetWs.Range("E:E").Find(What:=currentYM, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not foundRow Is Nothing Then
        ' 已存在，提示是否覆盖
        If MsgBox("该年月数据已存在，是否覆盖？", vbYesNo, "重复提示") = vbYes Then
            ' 替换现有数据（根据实际数据列调整范围）
            targetWs.Range("E" & foundRow.Row & ":S" & foundRow.Row).Value = inputWs.Range("B5:S5").Value
        End If
    Else
        ' 无重复，新增数据
        lastRow = targetWs.Cells(targetWs.Rows.Count, "E").End(xlUp).Row + 1
        targetWs.Range("E" & lastRow & ":S" & lastRow).Value = inputWs.Range("B5:S5").Value
    End If
End Sub

关键说明

• 必须统一年月格式，避免因格式差异（如"2024/05"和"2024-05"）导致查找失败。
• 根据实际工作表结构，调整录入区域（inputWs.Range("B2")、inputWs.Range("B5:S5")）和目标列范围。

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