我如何 hinde/unhide 单元格之间的行与粗体 vba

How can I hinde/unhide rows between cells with bold font vba

我有一个数据(文本)列表,它按粗体标题排序,如下例所示。我正在寻找在标题下 hide/unhide 行的方法,如果可能的话,通过单击单元格。

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

这可以通过双击 A 列中包含粗体的行的任意位置来实现。

把这个放在你的作品sheet的私人代码sheet中(右键单击作品sheet名称选项卡,查看代码)。

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