时间戳

首页 > 解决方案 > 检查日期范围是否等于今天并将低于日期范围的值复制到新单元格

excel - 检查日期范围是否等于今天并将低于日期范围的值复制到新单元格

问题描述

我有多个水平日期范围，我需要查看其中一个是否 = 今天，如果是，则复制日期下方的单元格值并将它们粘贴到新单元格中。

我的桌子

我设法做到了 1 by 1 和多次复制粘贴。

Sub copyModes()

If Range("R29") = Date Then
    Range("R30:R34").Select
    Selection.Copy
    Range("P37:P41").Select
    ActiveSheet.Paste
End If

If Range("U29") = Date Then
    Range("U30:U34").Select
    Selection.Copy
    Range("P37:P41").Select
    ActiveSheet.Paste
End If

If Range("S29") = Date Then
    Range("S30:S34").Select
    Selection.Copy
    Range("P37:P41").Select
    ActiveSheet.Paste
End If

If Range("T29") = Date Then
    Range("T30:T34").Select
    Selection.Copy
    Range("P37:P41").Select
    ActiveSheet.Paste
End If

If Range("V29") = Date Then
    Range("V30:V34").Select
    Selection.Copy
    Range("P37:P41").Select
    ActiveSheet.Paste
End If

End Sub

标签： excelvba

解决方案

您可以像这样使用通用子：

Sub CheckRangeAndCopy(rng As Range)
    If rng.value = Date Then
        rng.Offset(1, 0).Resize(5, 1).Copy Range("P37:P41")
    End If
End Sub

然后调用它：

CheckRangeAndCopy Range("T29")
CheckRangeAndCopy Range("V29")
' and so on

推荐阅读