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

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中任何单元格的任何字符与任何其他字符< em>任何其他单元格然后返回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")

Answer 2

通过传递范围而不是使用Select并在第一次失败时立即返回，您可能会略微提高速度：

Function fnCalibriCheck(SelectedRng As Range) As String

    Dim CurrentCell As Range
    Dim F As Long

    fnCalibriCheck = "calibri"
    For Each CurrentCell In SelectedRng
        If CurrentCell.Value <> "" Then
            For F = 1 To Len(CurrentCell)
                If CurrentCell.Characters(F, 1).Font.Name <> "Calibri" Then
                    fnCalibriCheck = "not calibri"
                    Exit Function
                End If
            Next
        End If
    Next
End Function