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没有激活我请求的窗口造成的。

编辑:因为很多人已经写到这是一个溢出错误，因为没有找到粗体单元格，所以我想要打开/选择的窗口“满”都是粗体单元格。

Answer 1

如果要激活

1. Preset.xlsm，它必须处于打开状态。
2. 可捕获应用程序中的错误。在not
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的第一个工作表，但您当然可以指定其他工作表。

@下面的注释:为什么要迭代UsedRange中的所有单元格？OP只需要B列。

好吧，这样会更快：

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