• Как динамически скрывать строки?

    @coi175 Автор вопроса
    Отвечаю сам себе, не знаю чем вызвано такое поведение, но никак не смог сделать через фильтры, даже с VBA, ощущение что EXCEL смотрит нижнюю и верхнюю дату и по ним фильтрует, а если они вразнобой, фиг. Написал следующие VBA:
    Сам метод скрытия строк по условию, лежит в модуле. (даты лежат в B1 и B2):
    Sub ApplyDateFilter(ws As Worksheet)
        Dim startDate As Date, endDate As Date
        Dim lastRow As Long
        ' Get the start and end dates from cells B1 and B2
        startDate = ws.Range("B1").Value
        endDate = ws.Range("B2").Value
    
        ' Determine the last row with data in column A (assumes dates are in column A)
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
        ' Remove any existing filters
        If ws.AutoFilterMode Then ws.AutoFilterMode = False
        
        ' Unhide all rows first to avoid hidden rows interfering with the filter
        ws.Rows.Hidden = False
    
        ' Loop through each row and hide those not in the date range or that do not match the status
        For Each cell In ws.Range("A6:A" & lastRow + 1) ' Assuming data starts in row 2
            If IsDate(cell.Value) Then
                If cell.Value < startDate Or cell.Value > endDate Then
                    cell.EntireRow.Hidden = True
                End If
            End If
        Next cell
    End Sub


    В самой книге, ставим при открытии файла даты на начало - конец текущего месяца:
    Private Sub Workbook_Open()
        Dim ws As Worksheet
        Set ws = Лист1
    
        ' Set the start and end dates for the current month in cells B1 and B2
        ws.Range("B1").Value = DateSerial(Year(Date), Month(Date), 1)
        ws.Range("B2").Value = DateSerial(Year(Date), Month(Date) + 1, 0)
    
        ' Apply the initial filter based on these dates
        ApplyDateFilter ws
    End Sub

    И на листе, чтобы при изменении дат снова крутился фильтр:
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Me.Range("B1:B2")) Is Nothing Then
            ApplyDateFilter Me
        End If
    End Sub
    
    Private Sub Worksheet_Activate()
        ' Ensure filter is applied when the sheet is activated
        ApplyDateFilter Me
    End Sub
    Ответ написан
    1 комментарий