基于Excel单元格日期值筛选复制指定列的VBA代码修改需求

实现逻辑 #

• 仅复制「Banks」工作表中G列赎回日期大于当前日期+6个月的行
• 只提取每行的ISIN-code（B列）和Common name（C列），粘贴到「New Banks」工作表的A、B列（从第3行开始）
• 执行前自动清空「New Banks」表A3:B1000区域的旧数据

完整代码 #

Sub Copydata()
    Application.ScreenUpdating = False
    
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRow As Long, targetRow As Long
    Dim i As Long
    
    ' 初始化目标工作表并清空旧数据
    Set wsTarget = Sheets("New Banks")
    wsTarget.Range("A3:B1000").ClearContents
    targetRow = 3 ' 目标表起始行
    
    ' 初始化源工作表
    Set wsSource = Sheets("Banks")
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row ' 适配任意数据量的最后一行获取方式
    
    ' 逐行检查条件并复制数据
    For i = 2 To lastRow
        ' 判断G列赎回日期是否大于当前日期加6个月
        If wsSource.Cells(i, "G").Value > DateAdd("m", 6, Date) Then
            ' 复制B列（ISIN-code）到目标表A列
            wsTarget.Cells(targetRow, "A").Value = wsSource.Cells(i, "B").Value
            ' 复制C列（Common name）到目标表B列
            wsTarget.Cells(targetRow, "B").Value = wsSource.Cells(i, "C").Value
            targetRow = targetRow + 1 ' 目标行下移，准备下一条数据
        End If
    Next i
    
    Application.ScreenUpdating = True
End Sub

关键说明 #

• DateAdd("m", 6, Date)：精准计算当前日期向后推6个月的日期，避免手动计算的误差
• 逐行遍历判断：替代原有的整列复制，确保只保留符合条件的数据
• 动态获取最后一行：用wsSource.Rows.Count代替固定的1000，适配不同行数的数据源
• 关闭屏幕刷新：减少代码执行时的界面闪烁，提升运行效率

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