我试图在微跟踪工作表中显示最近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
答案 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
这是假设:
cells(1, 1)
语句中的第二个数字更改为行的编号。如果日期不在第1行开始,请将cells(1, 1)
语句的第一个数字更改为第一个日期的行号。如果您想在一年前保留当天的行(例如,在1-15-15之间保持1-15-14),您可能需要更改第5行中的365
代码366
。此代码还假定除了昨天可见但不需要今天的所有其他行都已隐藏。
答案 1 :(得分:0)
这是一种完全不同的方法,但从长远来看可能更适合你。
而不是隐藏行以查看您感兴趣的内容。此方法使用两张纸。
日志表:包含所有日期
报告表:仅重新填写过去365天。
设置已参与:
为报告设置第二张表格,并为其提供与日志表相同的标题。
放置模块中提供的代码
如果需要,可以添加工作簿事件,这样当工作簿打开时,您可以调用此子设备并让其自行更新,或将其附加到热键或按钮。
这为您提供了足够的空间来创建新的公式和图表,以便在报告表的设定范围内工作。您可以隐藏日志表。
<强>代码:强>
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。