excel - 循环访问日期以复制特定列

Question

我整理数据以查看同事的工作班次。

Sheet1 包含一个显示班次的表格。这些班次时间被制定。我正在尝试将班次数据复制并粘贴为基于今天日期的值。

例如，如果今天是 2020 年 12 月 31 日，则复制范围 C3:F10 并粘贴为值（即此日期之前的数据）。当日期更改为下一天时，范围将从 C3:F10 更改为 C3:G10。这我要连续（一年中的每一天都有一个专栏）

这就是我到目前为止所拥有的。我需要一些方向。

Private Sub test()
    For i = c1 To h1
        If Worksheets("Sheet1").Cells(i, 1).Value <= Date Then
            Worksheets("Sheet1").Column(i).Copy
            ActiveSheet.pastevalues
        End If
    Next
End Sub

标签： excelvba

Answer 1

这是你正在尝试的吗？我已经对代码进行了注释，因此您理解它应该没有问题。但如果你这样做了，那就简单地问。

代码：

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long
    Dim lCol As Long
    Dim lRow As Long
    Dim rng As Range
    
    '~~> Change this to the relevant sheet
    Set ws = Sheet1
    
    With ws
        '~~> Find last column which has data in row 1
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        '~~> Find last row which has data in Col A
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        '~~> Loop through the dates
        For i = 3 To lCol
            '~~> Check if the date is less than today's date
            If .Cells(1, i).Value2 < Date Then
                '~~> identify your range
                If rng Is Nothing Then
                    '~~> Row 3 to last row
                    Set rng = .Range(.Cells(3, i), .Cells(lRow, i))
                Else
                    '~~> Joining ranges
                    Set rng = Union(rng, .Range(.Cells(3, i), .Cells(lRow, i)))
                End If
            Else
                Exit For
            End If
        Next i
        
        '~~> Convert to values in one go
        If Not rng Is Nothing Then rng.Value = rng.Value
    End With
End Sub

在行动：

我创建了一个示例文件来测试上面的代码。