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

找到此功能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"))

Answer 3

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

我认为将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

在Excel中取消隐藏隐藏的行

3 个答案: