Excel 基于一列中的值在两行之间插入行,但忽略隐藏行

Excel 基于一列中的值在两行之间插入行,但忽略隐藏行,excel,vba,Excel,Vba,我必须为即将到来的事件生成一个电子表格,我使用一个宏来创建一条粗线,将每个日期与上面的日期分开。它基于日期列中的值更改。然而,有时我不得不用另一个标准来过滤数据,比如说县。在这些情况下,我使用的偏移宏并不总是有效的,因为更改和生成线条的数据位于隐藏行中,因此线条也是如此。有人能帮忙吗 我已经尝试过各种方法将范围定义为仅活动单元格,但我认为我做得不对 我使用的宏如下所示,不应用于隐藏行: Sub UpcomingLines() Application.ScreenUpdating = Fa

我必须为即将到来的事件生成一个电子表格,我使用一个宏来创建一条粗线,将每个日期与上面的日期分开。它基于日期列中的值更改。然而,有时我不得不用另一个标准来过滤数据,比如说县。在这些情况下,我使用的偏移宏并不总是有效的,因为更改和生成线条的数据位于隐藏行中,因此线条也是如此。有人能帮忙吗

我已经尝试过各种方法将范围定义为仅活动单元格,但我认为我做得不对

我使用的宏如下所示,不应用于隐藏行:

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
我尝试过像这样集成特殊单元:

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
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

但是,这会在我不想要的地方生成行-基本上,日期之间的显示会更改,但每个地方都有一个隐藏行,即使在隐藏行之前或之后没有日期更改。

尝试以下操作:

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
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

似乎不管你怎么做,当你取消过滤数据时,总是有行在错误的地方。那有关系吗?对于范围A1:A100和LastRow中的每个rng,这应该是范围A1:A0和LastRowNo中的每个rng。。。我有一个宏,将取消隐藏,重新排序和重新绘制数据后,我做了过滤我需要的。谢谢!