根据日期隐藏行

时间:2015-01-16 03:08:42

标签: excel vba excel-vba

我试图在微跟踪工作表中显示最近365天。当输入新日期时,它将隐藏工作表上的第一个可见条目,以便始终只显示365个单元格,最新日期位于底部(2015年1月15日),最旧日期位于顶部(2014年1月15日) )。当用户输入Jan 16, 2015时,它会隐藏Jan 15, 2014,以便第一个条目现在为Jan 16, 2014,依此类推。

自从我上次使用VBA以来可能已经过了大约15年,但目前下面显示的代码将隐藏第3行(输入第一个日期和数据的位置)但之后我无法将其隐藏到第4行第369行输入了文本。我非常感谢您对我可能做错的一些见解。

我还会假设随着这张纸逐渐变大,它会在打开或平稳运行时开始变慢,所以除非有办法确保它始终保持快速,否则我必须重新开始。

Dim i As Integer
Dim j As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    i = 3
    j = 368
    If Cells(j, j) = "" Then
        Rows(i).Hidden = True
    End If
    i = i + 1
    j = j + 1
End Sub

3 个答案:

答案 0 :(得分:0)

这应该可以解决问题:

Sub HideRows()
    Dim lngLastRow As Long
    lngLastRow = Sheets("Sheet1").Cells(1, 1).End(xlDown).Row
    If lngLastRow < 365 Then End
    Rows(lngLastRow - 365).Hidden = True
End Sub

这是假设:

  1. 您正在使用名为“Sheet1”的工作表(如果没有,请相应地更改代码第3行中的名称)
  2. 日期在A列中,从第1行开始(即使是隐藏的日期)。如果日期位于不同的列中,则将cells(1, 1)语句中的第二个数字更改为行的编号。如果日期不在第1行开始,请将cells(1, 1)语句的第一个数字更改为第一个日期的行号。
  3. 如果您想在一年前保留当天的行(例如,在1-15-15之间保持1-15-14),您可能需要更改第5行中的365代码366。此代码还假定除了昨天可见但不需要今天的所有其他行都已隐藏。

答案 1 :(得分:0)

这是一种完全不同的方法,但从长远来看可能更适合你。

而不是隐藏行以查看您感兴趣的内容。此方法使用两张纸。

  1. 日志表:包含所有日期

  2. 报告表:仅重新填写过去365天。

  3. 设置已参与:

    • 为报告设置第二张表格,并为其提供与日志表相同的标题。

    • 放置模块中提供的代码

    • 如果需要,可以添加工作簿事件,这样当工作簿打开时,您可以调用此子设备并让其自行更新,或将其附加到热键或按钮。

    这为您提供了足够的空间来创建新的公式和图表,以便在报告表的设定范围内工作。您可以隐藏日志表。

    <强>代码:

    Sub lastYearReportFill()
    
    Dim lastRow As Long, lastCol As Long, lRow As Long, rRow As Long
    Dim log As String, report As String
    Dim today As Date, tempDate As Date
    Dim daysTest As Long
    
    log = "Log"             'Name your worksheets here
    report = "Report"
    today = Now
    
    lastRow = Sheets(log).Range("A" & rows.count).End(xlUp).row
    lastCol = Sheets(log).Cells(2, Columns.count).End(xlToLeft).column   'Using Header Row
    
        For lRow = 3 To lastRow
            tempDate = Sheets(log).Cells(lRow, 1)
            daysTest = DateDiff("d", tempDate , today)
            If daysTest = 365 Then
                Exit For
            End If
        Next lRow
    
        For rRow = 3 To 368
            For lCol = 1 To lastCol
                Sheets(report).Cells(rRow, lCol).Value = Sheets(log).Cells(lRow, lCol).Value
            Next lCol
            lRow = lRow + 1
        Next rRow
    
    End Sub
    

答案 2 :(得分:0)

如果您关注速度,请使用范围自动过滤方法,我已回答HERE
将它应用于您的案例:

Private Sub UpdateVisibleDates(sh As Worksheet, drng As Range)
    With sh
        Dim latest As Date
        latest = .Range("A:A").Find("*", .Range("A1"), , , , xlPrevious).Value2
        .AutoFilterMode = False
        drng.AutoFilter 1, ">" & (latest - 365), xlAnd, "<=" & latest, False
    End With
End Sub

然后只需在 Worksheet_Change事件中调用它。

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo halt
    Application.EnableEvents = False
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        Dim r As Range
        Set r = Me.Range("A1:A" & Me.Range("A:A") _
            .Find("*", Me.Range("A1"), , , , xlPrevious).Row)
        UpdateVisibleDates Me, r
    End If
forward:
    Application.EnableEvents = True
    Exit Sub
halt:
    MsgBox "Error: " & Err.Number & vbCrLf & _
        Err.Description, vbExclamation
    Resume forward
End Sub    

这是考虑到您在A栏中有一个完整的日期,而您的输入并没有跳过日期 但无论如何,它仍然会隐藏不在最后输入日期的365日期差异内的日期。 HTH。

相关问题