Вставить строки между значениями в одном столбце, но игнорировать скрытые строки

Question

Мне нужно создать электронную таблицу предстоящих событий, и я использую макрос, который создает толстую линию, отделяющую каждую дату от даты над ней. Он основан на изменении значения в столбце «Дата». Однако иногда мне приходится фильтровать данные по другому критерию (например, округ). В этих случаях используемый мной макрос смещения не всегда работаетТак как данные, которые изменяют и производят линию, находятся в скрытой строке, и, следовательно, линия тоже. Может ли кто-нибудь помочь?

Я пробовал различные способы определения диапазона только как активные ячейки, ноЯ не думаю, что я делаю это правильно.

Макрос, который я использую, заключается в следующем, без применения к скрытым строкам:

Sub UpcomingLines()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("A1:A100" & LastRow)
        If rng <> rng.Offset(1, 0) Then
            Range("A" & rng.Row & ":H" & rng.Row).Borders(xlEdgeBottom).Weight = xlThick
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Я пытался интегрировать SpecialCells, какthis:

Sub UpcomingLines()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Set myrange = Range("A1:H" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
    For Each rng In Range("A1:A100" & LastRow)
        If rng <> rng.Offset(1, 0) Then
            Range("A" & myrange.Row & ":H" & rng.Row).Borders(xlEdgeBottom).Weight = xlThick
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Тем не менее, это создает строки в местах, которые мне не нужны - в основном, отображение между изменениями даты, но также везде, где есть скрытая строка, даже если даты нетизменить до или после скрытого ряда.

Answer 1

Попробуйте что-то вроде этого:

Sub UpcomingLines()

    Dim ws As Worksheet, LastRow As Long, c As Range, theDate

    Application.ScreenUpdating = False

    Set ws = ActiveSheet
    ws.Range("A1").CurrentRegion.Borders.LineStyle = xlNone 'remove existing borders

    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    theDate = 0
    For Each c In ws.Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
        'different date from previous visible row?
        If c.Value <> theDate Then
            'add border to top of row if not the first change
            If theDate <> 0 Then c.Resize(1, 8).Borders(xlEdgeTop).Weight = xlThick
            theDate = c.Value 'remember this date
        End If
    Next c

    Application.ScreenUpdating = True
End Sub