VBA - 检查单元格的内容是否为粗体

Question

我目前正在尝试使用VBA在Excel中创建日历。 现在我需要检查B列中的单元格是否格式化为粗体。由于粗体格式化的行可以改变其位置，我需要检查B列中的每个单元格，如果其内容是粗体。 我目前的代码：

Sub ScanBlock1()

Dim Zelle As Integer
Dim Cell As String
Dim found As Integer

Zelle = 7
Zell = "B" & Zelle
found = 0

'CopyCat.OpenCopyCat
Windows("Preset.xlsm").Activate

Do While found = 0
    Windows("Preset.xlsm").Activate
    Range(Zell).Select
    If Range(Zell).Font.Bold Then
        'Save start and end for copycat
        found = 1
    Else
        Zelle = Zelle + 2
    End If
Loop

End Sub

在尝试这个时，我遇到了多个问题。 我遇到的第一个问题是，Excel不会自动激活请求的窗口。我不知道为什么。它一直在其他项目中运作。 第二个问题：我的IF声明总是出现溢出错误。我认为这是因为Excel没有激活我请求的窗口。 编辑：因为许多人已经写过这是一个溢出错误，因为没有BOLD CELL被发现，我想打开/选择的窗口是“完整”的粗体单元格。

Answer 1

1. 如果要激活Preset.xlsm，则必须打开它。
2. 捕获应用中的错误。
3. 第二次激活（在循环内）不必要
4. 你增加了zellE的值（无休止地），但是你没有更新Zell

试试这个：

Zelle = 7
zMAX=1000

found = 0
Windows("Preset.xlsm").Activate
if Err.Number <> 0 then goto errorlabel   ' process error

Do While found = 0 or Zelle < zMAX
    Zell = "B" & Zelle
    If Range(Zell).Font.Bold Then
        'Save start and end for copycat
        found = 1
    Else
        Zelle = Zelle + 2
    End If
Loop

If Zelle >= zMAX then
   Msgbox "Problem!"
Endif

我个人更喜欢直接的单元格引用，而不是打扰字符串，所以在这里你是一个替代解决方案：

zMAX=1000
Windows("Preset.xlsm").Activate
if Err.Number <> 0 then goto errorlabel   ' process error

for Zelle = 7 to zMAX Step 2
    If Cells(Zelle, 2).Font.Bold Then Exit For ' "2" for column "B"
Next
If Zelle >= zMAX then
   Msgbox "Problem!"
Else
   ' Bold found, Save start and end for copycat
Endif

Answer 2

您已将Zelle定义为整数，它可能最大为32767，而Excel有大约一百万行。快速解决方案是改变声明：

Dim Zelle As Integer

但是运行这个宏可能需要很长时间。您应该将此限制为UsedRange并使用对象循环。喜欢：

Dim cl as Range

For each cl in Workbooks("Preset.xlsm").Worksheets(1).UsedRange
  If Range(Zell).Font.Bold Then
     'Do something
  End If
Next cl

这适用于第一张Preset.xlsm，但您可以指出其他表格。

@comment如下：为什么迭代UsedRange中的所有单元格？ OP只需要B列。

好吧，这样会更快：

For each cl in Workbooks("Preset.xlsm").Worksheets(1).UsedRange.Columns(2)