取消隐藏 Excel 中的隐藏行

Question

这是我当前的代码。如果找到隐藏行，它会在行周围放置红色边框，一个 MsgBox 详细说明隐藏了哪些行，并将隐藏行的大小调整为 15 的高度。除非隐藏的行是该范围内的最后一行，否则它可以正常工作。如果它们是范围中的最后一行，则此代码会取消隐藏它们，但不会应用红色边框，并且 MsgBox 不会将这些行包含在报告的隐藏行列表中。

这是因为如果最后一行被隐藏，这种查找最后一行的方法不起作用吗？还是该方法可以接受，我只需要添加/更改一些东西？

Sub UnhideRows()
Dim LastRow As Integer
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Dim rng As Range
    Dim r As Range
    Dim sTemp As String

    Set rng = Range("A84:A" & LastRow)
    sTemp = ""
    For Each r In rng.Rows
        If r.EntireRow.Hidden = True Then
            sTemp = sTemp & "Row " & Mid(r.Address, 4) & vbCrLf
            r.EntireRow.Hidden = False
                With Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeLeft)
                     .Color = -16776961
                     .Weight = xlMedium
                End With

                With Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeTop)
                     .Color = -16776961
                     .Weight = xlMedium
                End With

                With Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeBottom)
                     .Color = -16776961
                     .Weight = xlMedium
                End With

                With Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeRight)
                     .Color = -16776961
                     .Weight = xlMedium
                End With
        End If
    Next r

     If sTemp <> "" Then
        sTemp = "The following rows were hidden:" & vbCrLf & _
          vbCrLf & sTemp
          MsgBox sTemp
     Else

     End If

         Cells.rowheight = 15
End Sub

Answer 1

试试

Option Explicit

Public Sub UnhideRows()
    Dim LastRow As Long, rng As Range, r As Range, sTemp As String

    With ActiveSheet
        LastRow = .Cells.Find("*", [a1], xlFormulas, , xlByRows, xlPrevious).Row
        Set rng = .Range("A84:A" & LastRow)
        sTemp = vbNullString

        For Each r In rng.Rows
            If r.EntireRow.Hidden Then
                sTemp = sTemp & "Row " & Mid(r.Address, 4) & vbCrLf
                r.EntireRow.Hidden = False

                With .Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeLeft)
                    .Color = -16776961
                    .Weight = xlMedium
                End With
                With .Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeTop)
                    .Color = -16776961
                    .Weight = xlMedium
                End With
                With .Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeBottom)
                    .Color = -16776961
                    .Weight = xlMedium
                End With
                With .Range("A" & r.Row & ":W" & r.Row).Borders(xlEdgeRight)
                    .Color = -16776961
                    .Weight = xlMedium
                End With
            End If
        Next r

        If sTemp <> vbNullString Then
            sTemp = "The following rows were hidden:" & vbCrLf & _
                    vbCrLf & sTemp
            MsgBox sTemp
        End If
        .Cells.RowHeight = 15
    End With
End Sub

我最初会重构它，以便从使用 Union 一次性处理所有行中受益。

Option Explicit

Public Sub UnhideRows()
    Dim LastRow As Long, rng As Range, r As Range, sTemp As String, unionRng As Range, borders(), i As Long
    With ActiveSheet
        LastRow = .Cells.Find("*", [a1], xlFormulas, , xlByRows, xlPrevious).Row
        Set rng = .Range("A84:A" & LastRow)
        sTemp = vbNullString

        For Each r In rng.Rows
            If r.EntireRow.Hidden Then
                sTemp = sTemp & "Row " & Mid(r.Address, 4) & vbCrLf
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, r.Resize(1, 23))
                Else
                    Set unionRng = r.Resize(1, 23)
                End If
            End If
        Next r

        If Not unionRng Is Nothing Then
            With unionRng
                .EntireRow.Hidden = False
                .borders(xlEdgeLeft).Color = -16776961
                .borders(xlEdgeLeft).Weight = xlMedium
                .borders(xlEdgeTop).Color = -16776961
                .borders(xlEdgeTop).Weight = xlMedium
                .borders(xlEdgeBottom).Color = -16776961
                .borders(xlEdgeBottom).Weight = xlMedium
                .borders(xlEdgeRight).Color = -16776961
                .borders(xlEdgeRight).Weight = xlMedium
            End With
        End If

        If sTemp <> vbNullString Then
            sTemp = "The following rows were hidden:" & vbCrLf & _
                    vbCrLf & sTemp
            MsgBox sTemp
        End If
        .Cells.RowHeight = 15
    End With
End Sub

Answer 2

似乎确实如此。查找最后一行的方法会跳过隐藏行。

我想把LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row改成

With ActiveSheet.Cells(Rows.Count, 1).End(xlUp)
    If .Offset(1).EntireRow.Hidden = True Then
        LastRow = .Offset(1).Row
    Else
        LastRow = .Row
    End If
End With

会成功的

编辑 如果在范围末尾可以隐藏超过 2 行：

With ActiveSheet.Cells(Rows.Count, 1).End(xlUp)
For hidden_ones = 0 To ActiveSheet.Rows.Count
    If .Offset(hidden_ones + 1).EntireRow.Hidden = False Then Exit For
Next hidden_ones
    LastRow = .Offset(hidden_ones).Row
End With

Answer 3

把这个函数找到here

Function FindLastRow(R As Range) As Long
    Const NotFoundResult = 1 ' If all cells have an empty value, this value is returned
    FindLastRow = R.Worksheet.Evaluate("IFERROR(LARGE(ROW('" & R.Worksheet.Name & "'!" & R.Address & ")*--('" & R.Worksheet.Name & "'!" & R.Address & " <> """"),1)," & NotFoundResult & ")")
End Function

然后像这样调整你的代码

LastRow = FindLastRow(ActiveSheet.Range("A:A"))