单元格中的所有文本都使用相同的字体吗？

Question

我正在处理一些Excel文件,这些文件通常在单元格中有很多文本.我想运行检查以确保所有文本都是相同的字体(特别是Calibri).

目前,我有这样做的方式.但它运行得非常慢.

Function fnCalibriCheck() As String

Dim CurrentCell As Range                                ' The current cell that is being checked
Dim SelectedRng As Range                                ' The selection range
Dim F As Long
Set SelectedRng = ActiveSheet.Range(Selection.Address)  ' Defines the selection range

For Each CurrentCell In SelectedRng                     ' Goes through every cell in the selection and performs the check

    For F = 1 To Len(CurrentCell)
        If CurrentCell.Characters(F, 1).font.Name <> "Calibri" Then
            fnCalibriCheck = "not calibri"
        End If
    Next

Next
End Function

问题似乎是Font.Name属性特有的.例如,如果我运行相同的代码,但我搜索特定字符而不是Font.Name,那么它运行完全正常.虽然如此,我当前的宏可能需要几秒钟才能运行,偶尔会崩溃.

我想知道是否有人可以提出更好的选择.

Answer 1

通过利用Range Font.Name属性的以下行为,您可以大大加快速度:

• 如果所有单元格中的所有字符都range具有相同的字体,则返回该字体名称

• 如果任何字符的任何小区中range具有不同的字体比任何其他字符的任何其他细胞则它返回Null

所以你可以简单地编码:

Function fnCalibriCheck() As String
    If IsNull(Selection.Font.Name = "Calibri") Then fnCalibriCheck = "not Calibri"
End Function

您可以通过接受扫描范围和要检查的字体作为参数来使其更加通用

Function fnFontCheck(rng As Range, fontName As String) As String
    If IsNull(rng.Font.Name = fontName) Then fnFontCheck = "not " & fontName
End Function

可以如下调用:

MsgBox fnFontCheck(Selection, "Calibri")