在VBA中搜索和返回粗體值

Question

我知道這可能不是執行此操作的最理想方法，請耐心等待。

我有一個上面有幾張桌子的文件。 我正在使用一種用戶窗體來搜索表/子類別並返回相關值。 我想在用戶窗體上使用一系列選項按鈕來選擇子類別，這些子類別又將設置搜索功能在其中查找的范圍。 我還想動態地更新選項按鈕，如果要添加一個新表或沿這些行的內容。

唯一區分子類別/表的標題及其中項目的是，子類別/表的標題為粗體。 因此，我要搜索的是電子表格的第一列，並以粗體返回所有條目的名稱。 這些值然后用於設置選項按鈕的名稱：)。

下面的函數是我試圖在a列中找到粗體的文本實體，將其返回並將它們設置為要在另一個函數中使用的單獨變量的嘗試。 我在另一個子目錄中需要它們時， bold1 ....變量都是全局定義的變量，包含要使用的相關頁面的page變量也是如此。 當前代碼返回一個錯誤，指出“變量或未設置塊”，使用調試器，我可以看到bold1 ....和所有其他的boldx變量都未設置值。 是否有人知道發生了什么/如何修復此功能。

提前致謝 ：）

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列中粗體單元格的值數組。

您可以使用這些值的list屬性填充組合框或列表框。

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