在VBA中搜索和返回粗體值

Question

我知道這可能不是最理想的方式來做到這一點，但只是忍受着我。

我一張有幾桌的文檔。我正在使用一個用戶表單來搜索表/子類別並返回相關的值。我想用一個用戶窗體上的一系列選項按鈕來選擇子類別，這些將依次設置搜索功能的範圍。我還想動態更新選項按鈕，如果要添加一個新表或任何沿這些行。

區別於內它的一個子類/表的標題，和項目的唯一，是一個子類/表的標題是大膽的。所以我想要做的就是搜索電子表格的第一列，並以粗體返回任何條目的名稱。這些值然後用於設置選項按鈕的名稱:)。

下面的函數是我發現在列文實體以粗體顯示，返回他們並設置每個到單個變量在另一個函數中使用的嘗試。 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

中存儲找到的單元格的內容（文檔中的任何單元格在此階段以粗體顯示）1034這將從頁面的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