在 VBA 中搜索和返回粗体值

Question

我知道这可能不是最理想的方法，但请耐心等待。

我有一份文件，上面有几张桌子。我正在使用用户表单来搜索表/子类别并返回相关值。我想在用户窗体上选择具有一系列选项按钮的子类别，这些将反过来设置搜索功能的范围。如果要添加新表或任何类似的内容，我还想动态更新选项按钮。

区分子类别/表格的标题和其中的项目的唯一区别是子类别/表格的标题是粗体的。所以我要做的是搜索电子表格的第一列并以粗体返回任何条目的名称。然后这些值用于设置选项按钮的名称:)。

以下函数是我尝试在 a 列中以粗体显示的文本实体，返回它们并将每个实体设置为单独的变量以在另一个函数中使用。 bold1 .... 变量都是全局定义的变量，因为我需要它们在另一个子中，page 变量包含要使用的相关页面。目前，代码返回一个错误，指出“变量或未设置块”并使用调试器我可以看到bold1 .... 和所有其他粗体变量都没有设置值。有谁知道发生了什么/如何修复此功能。

提前致谢:)

Sub SelectBold()
    Dim Bcell As Range
    For Each Bcell In Worksheets(Page).Range("A1:A500")
        If Bcell.Font.Bold = True Then
            Set bold1 = Bcell
        End If
    Next
End Sub

编辑：我简化了上述功能，以消除混乱并帮助缩小问题范围。我希望上面的函数将找到的单元格的内容（此阶段文档中的任何单元格以粗体显示）存储在变量bold1

Answer 1

这将从页面 A 列中的粗体单元格返回一个值数组。

您可以使用这些值的列表属性填充组合框或列表框。

ComboBox1.List = getSubCategories("Sheet1")

Function getSubCategories(Page As String) As String()

    Dim arrSubCategories() As String
    Dim count As Long
    Dim c As Range

    With Worksheets(Page)
        For Each c In .Range("A2", .Range("A" & Rows.count).End(xlUp))
            If c.Font.Bold Then
                ReDim Preserve arrSubCategories(count)
                arrSubCategories(count) = c.Value
                count = count + 1
            End If
        Next
    End With

    getSubCategories = arrSubCategories
End Function

Answer 2

您可能会发现返回 Range 并找到子类别单元格很有用：

Function SelectBold(Page As String, colIndex As String) As Range
    With Worksheets(Page)
        With .Range(colIndex & "1", .Cells(.Rows.Count, colIndex).End(xlUp)).Offset(, .UsedRange.Columns.Count)
            .FormulaR1C1 = "=if(isbold(RC[-1]),"""",1)"
            .Value = .Value
            If WorksheetFunction.CountA(.Cells) < .Rows.Count Then Set SelectBold = Intersect(.SpecialCells(xlCellTypeBlanks).EntireRow, .Parent.Columns(1))
            .Clear
        End With
    End With
End Function

Function IsBold(rCell As Range)
    IsBold = rCell.Font.Bold
End Function

可能被如下利用：

Option Explicit

Sub main()
    Dim subCategoriesRng As Range, cell As Range

    Set subCategoriesRng = SelectBold(Worksheets("bolds").Name, "A") '<--| pass worksheet name and column to search in

    If Not subCategoriesRng Is Nothing Then
        For Each cell In subCategoriesRng '<--| loop through subcategories cells
            '... code
        Next cell
    End If
End Sub