求老师修改代码

王跃峰

Private Sub Workbook_Open()
Dim j%
Application.ScreenUpdating = False
With Sheets("全年日历")
    r = .[F65536].End(xlUp).Row
    For i = 1 To r
        .Cells(i, 1).EntireRow.Hidden = True
        If .Cells(i, 1).Value = VBA.Date Then
            Select Case i
            Case 1 To 10
                .Rows("1:10").Hidden = False
            Case 10 To r – 10
                .Rows((i + 10) & ":" & i).Hidden = False
            Case r To r – 10
                .Rows(r & ":" & (r - 10)).Hidden = False
            End Select
        End If
    Next
End With
Application.ScreenUpdating = True
End Sub

蓝桥玄霜

修改的例子：

psxk3535

用条件格式：公式：=DATEDIF($A4,TODAY(),"d")<10  格式自定，应用：=$A$4:$A$1000

王跃峰

蓝桥玄霜 发表于 2023-2-11 20:10
修改的例子：

太感谢老师了，请问能不能用case语句或if语句或其它办法做一下

王跃峰

psxk3535 发表于 2023-2-11 22:22
用条件格式：公式：=DATEDIF($A4,TODAY(),"d")

感谢帮助，但没实现

准提部林

不用case/if, 不除錯
前/后10天+當天=21天???

With Range(Sheet1.[a2], Sheet1.[a65536].End(3))
     .EntireRow.Hidden = False
     R = .Columns(1).Find(Date, Lookat:=xlWhole).Row - 1
     R1 = R - 10: If R1 < 1 Then R1 = 1
     .EntireRow.Hidden = True
     Range(.Cells(R1, 1), .Cells(R + 10, 1)).EntireRow.Hidden = False
End With

王跃峰

准提部林 发表于 2023-2-12 12:33
不用case/if, 不除錯
前/后10天+當天=21天???

牛！牛！牛！老师麻烦您注释一下好吗？

准提部林

王跃峰 发表于 2023-2-12 15:39
牛！牛！牛！老师麻烦您注释一下好吗？

1) FIND...找出"今天日期"在A列中的行號.....因為日期從第2行開始, 所以要-1
2) 向上抓10行, 若行號不足, 則取第1行(註:這時行號是以日期區域來算的, 不是整個工作表)
3) 向下抓10行, 上/下區間就是要顯示的區域

psxk3535

王跃峰 发表于 2023-2-12 09:42
感谢帮助，但没实现

看你弄了一个红色标注单元格，以为是用颜色显示出来。条件格式不能隐藏行，所以无法实现，只有使用代码了