我如何阻止/取消隐藏带有粗体字体vba的单元格之间的行

时间:2018-07-09 08:56:30

标签: excel vba excel-vba show-hide

我有一个数据(文本)列表,该列表以粗体标题进行排序,如下例所示。我正在寻找一种隐藏/取消隐藏标题下行的方法,如果可能的话,请单击该单元格。

**Headline 1**
Test 
Test 
Test 
**Headline 2** 
Test 
Test 
**Headline 3**
Test 
Test 
Test 

从此开始,但是找不到使其工作的方法(我是VBA的新手)

Sub SortBold()

    Dim Rng As Range
    Dim WorkRng As Range
    Dim OutRng As Variant

    On Error Resume Next
    Set WorkRng = Sheets("Saftey functions").Range("A3:A20")
    For Each Rng In WorkRng
        If Rng.Font.Bold Then
            If OutRng Is Nothing Then
                Set OutRng = Rng
            Else
                Set OutRng = Union(OutRng, Rng)
            End If
        End If
    Next
    If Not OutRng Is Nothing Then
       OutRng.Select
    End If

    Dim i As Integer
    For i = 1 To UBound(OutRng)
    If Not OutRng(i) Is Nothing And Not OutRng(i + 1) Is Nothing Then _
        Rows(OutRng(i).Row & ":" & OutRng(i + 1)).Hidden = _
            Not Rows(OutRng(i).Row & ":" & OutRng(i + 1)).Hidden
    Next i
End Sub

1 个答案:

答案 0 :(得分:0)

这是通过双击A列中包含粗体的行上的任何地方来实现的。

将其放置在工作表的专用代码表中(右键单击工作表名称选项卡,查看代码)。

Option Explicit


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Debug.Print Target.Address(0, 0)
    If Cells(Target.Row, "A").Font.Bold Then
        Cancel = True
        On Error GoTo safe_exit
        Application.EnableEvents = False
        Dim rs As Long, re As Long, rng As Range
        rs = Target.Row + 1
        Application.FindFormat.Font.FontStyle = "Bold"
        Set rng = Cells.Find(What:="*", After:=Cells(Target.Row, "A"), LookIn:=xlFormulas, _
                             LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                             SearchFormat:=True)
        If rng.Row < rs Then
            re = Application.Match("zzz", Columns(1)) + 1
        Else
            re = rng.Row
        End If
        Cells(rs, "A").Resize(re - rs, 1).EntireRow.Hidden = Not Cells(rs, "A").EntireRow.Hidden
    End If
safe_exit:
    Application.EnableEvents = True

End Sub