VBA宏日期筛选问题：如何仅提取指定月份符合条件的Excel行？

问题原因 #

原代码中IsDateInMonth函数通过字符串拼接构造日期起始值，依赖系统日期格式解析。由于你的表格使用dd/mm/yyyy格式，CDate(VBA.Month(m) & "/01/" & VBA.Year(m))会被错误解析为1月X日（X为指定月份的数字），导致筛选范围变成当年年初到指定月末，而非目标月份。

修正后的完整代码 #

Function IsDateInMonth(d As Date, m As Date) As Boolean
    Dim dStart As Date
    Dim dEnd As Date
    
    ' 使用DateSerial构造日期，不受系统区域格式影响
    dStart = DateSerial(Year(m), Month(m), 1)
    dEnd = WorksheetFunction.EoMonth(m, 0)
    
    IsDateInMonth = (d >= dStart And d <= dEnd)
End Function

Sub Macro()
    Dim strCode As String
    Dim datDate As Date
    Dim rngCell As Range
    Dim lngLoop As Long
    Dim wksSource As Worksheet
    Dim wksTarget As Worksheet
    
    Set wksSource = ActiveWorkbook.Worksheets("TABLE")
    Set wksTarget = ActiveWorkbook.Worksheets("Sheet2")
    
    lngLoop = 2
    
    ' 明确指定从源工作表读取S1和T1的值
    strCode = wksSource.Range("S1").Value
    datDate = wksSource.Range("T1").Value
    
    For Each rngCell In wksSource.Range("S4:S30000")
        ' 先检查单元格是否为有效数据，避免空值或非日期干扰
        If Not IsEmpty(rngCell.Value) And IsDate(rngCell.Offset(, 1).Value) Then
            If rngCell.Value = strCode And IsDateInMonth(rngCell.Offset(, 1).Value, datDate) Then
                wksSource.Rows(rngCell.Row).Copy wksTarget.Rows(lngLoop)
                lngLoop = lngLoop + 1
            End If
        End If
    Next rngCell
End Sub

关键修改点 #

1. 日期构造方式：用DateSerial(Year(m), Month(m), 1)替代字符串拼接，直接按年、月、日生成目标月份的第一天，完全避免区域格式解析错误。
2. 明确数据源：读取S1和T1时指定wksSource，防止当前活动工作表切换导致的取值错误。
3. 增加有效性检查：循环中先判断单元格非空且为有效日期，避免空值或无效数据引发的错误。

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