根据date隐藏行

我正试图在微型跟踪工作表中保持最后365天的可见状态。 当一个新的date被input时，它会隐藏表单上的第一个可见条目，使得只有365个单元格不断显示，最新的date在底部（例如2015年1月15日）和最早的date在顶部（2014年1月15日）。 当用户inputJan 16, 2015 ，将隐藏Jan 15, 2014因此第一个条目现在是Jan 16, 2014 ，依此类推。

从上次使用的VBA开始，可能已经有15年了，但是目前下面显示的代码将隐藏第3行（input第一个date和数据的位置），但是在第369行之后，我无法获得第4行input文字。 一些洞察到我可能做错了将不胜感激。

我也会假设，随着这张表逐渐变大，它开始放缓或开始平稳运行，所以我必须重新开始，除非有办法确保它始终保持快速。

 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 

Answer 1

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

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

1. 日志表：包含所有日子

2. 报告表：仅填写最后365天。

涉及的设置：

• 为您的报告设置第二个工作表，并为其提供与日志表相同的标题。

• 放置模块中提供的代码

• 如果你愿意，你可以添加一个工作簿事件，这样当工作簿打开时，你可以调用这个子工具并自己更新，或者将它附加到一个热键或button上。

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

码：

 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 

Answer 2

这应该做的伎俩：

 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. date在A列，从第一行开始（甚至是隐藏的）。 如果date在不同的列中，则将cells(1, 1)语句中的第二个数字更改为该行的数字。 如果date不在行1中开始，将cells(1, 1)语句的第一个数字更改为第一个date的行号。

如果你想在一年前保留这一天的行（如1-15-15中保持1-15-14），则可能需要将代码第5行中的365更改为366 。 这段代码还假定除了昨天可见的，但今天不需要的其他行以外的所有行都已经隐藏起来了。

Answer 3

如果你关心的速度，使用范围自动筛选方法 ，我在这里回答。
将其应用于您的案例：

 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列中有一个完整的date，你的input不会跳过date。
但无论如何，它仍会隐藏不在上次inputdate的365date差异之内的date。 HTH。