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

我正在处理一些通常在单元格内有大量文本的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，我search一个特定的字符，然后它运行得很好。 就目前而言，我目前的macros可能需要几秒钟才能运行，偶尔也会崩溃。

我想知道是否有人可以提出一个更好的select。

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") 

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