代码检测隐藏的行,取消隐藏它们并应用边框

时间:2016-10-03 13:25:21

标签: excel vba excel-vba

我正在使用这一点VBA代码来检测电子表格中的隐藏行。除此之外,我希望它取消隐藏这些行,并突出显示以前隐藏的行中的单元格,从A到W的列带有红色边框。

Sub ShowRows()
    Dim rng As Range
    Dim r As Range
    Dim sTemp As String

    Set rng = Range("A1:A1000")
    sTemp = ""
    For Each r In rng.Rows
        If r.EntireRow.Hidden Then
            sTemp = sTemp & "Row " & Mid(r.Address, 4) & vbCrLf
        End If
    Next r

     If sTemp > "" Then
        sTemp = "The following rows are hidden:" & vbCrLf & _
          vbCrLf & sTemp
          MsgBox sTemp
     Else
         MsgBox "There are no hidden rows."
     End If 
End Sub

编辑:抱歉。我忘了提到这个脚本的后面部分将一些条件格式应用于所有行。无论此脚本的这一部分是在之前还是之后,我认为这无关紧要。但我不希望这取代其他格式,只需通过应用边框添加它。

2 个答案:

答案 0 :(得分:0)

这样的东西?:

Sub ShowRows()
    Dim rng As Range
    Dim r As Range
    Dim sTemp As String

    Set rng = Range("A1:A1000")
    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 are hidden:" & vbCrLf & _
          vbCrLf & sTemp
          MsgBox sTemp
     Else
         MsgBox "There are no hidden rows."
     End If 
End Sub

答案 1 :(得分:0)

只需添加行以取消隐藏并为行循环中的行着色

Sub ShowRows()
    Dim rng As Range
    Dim r As Range
    Dim sTemp As String
    Dim sTemp2 As String

    Set rng = Range("A1:A1000")
    sTemp = ""
    For Each r In rng.Rows
        If r.EntireRow.Hidden Then
            sTemp = sTemp & "Row " & Mid(r.Address, 4) & vbCrLf
            r.Hidden = False
            sTemp2 = "A" & Mid(r.Address, 4) & ":H" & Mid(r.Address, 4)
            Range(sTemp2).Borders.Color = vbRed
        End If
    Next r

     If sTemp > "" Then
         sTemp = "The following rows are hidden:" & vbCrLf & _
         vbCrLf & sTemp
         MsgBox sTemp
     Else
         MsgBox "There are no hidden rows."
     End If
End Sub