如何在Formatting Cells Based On Content宏中排除日期格式单元格？

问题描述 #

现有一个VBA宏，能把硬编码数值的字体改成亮蓝色，公式单元格字体改成黑色，但会误改那些设置了白色字体、深色背景的日期单元格（这些单元格用日期数字格式）。需求是修改宏，排除这类日期单元格；同时询问其他排除方式，比如排除带背景色的单元格，或排除包含EOMONTH/DATE/EDATE函数的公式单元格。

原宏代码：

Sub FormatCellsBasedOnContent()
 'color format macro
Dim myRange As Range
Set myRange = Selection
   
       Selection.SpecialCells(xlCellTypeConstants, xlNumbers).Font.Color = RGB(0, 0, 255) ' Blue
       Selection.SpecialCells(xlCellTypeFormulas).Font.Color = RGB(0, 0, 0)   ' Black

    
End Sub

用户尝试修改但失败的代码：

Sub FormatCellsBasedOnContent()
 'color format macro
Dim myRange As Range
Set myRange = Selection
   
       For Each cell In Selection
       If Selection.NumberFormat = "m/d/yyyy" Then ''
       ElseIf Selection.NumberFormat = "[$-en-US]mmm-yy;@" Then ''
       
       Else
       Selection.SpecialCells(xlCellTypeConstants, xlNumbers).Font.Color = RGB(0, 0, 255) ' Blue
       Else
       Selection.SpecialCells(xlCellTypeFormulas).Font.Color = RGB(0, 0, 0)   ' Black
       End If
Next
    
End Sub

方法一：排除日期格式的常量单元格 #

Excel里日期本质是数字，所以会被xlNumbers选中。我们可以遍历每个常量数字单元格，判断其数字格式是否为日期格式，不是的话再修改字体颜色：

Sub FormatCellsBasedOnContent()
    ' color format macro
    Dim myRange As Range
    Dim cell As Range
    
    Set myRange = Selection
    
    ' 处理常量数字单元格，排除日期格式
    On Error Resume Next ' 防止没有符合条件的单元格报错
    For Each cell In myRange.SpecialCells(xlCellTypeConstants, xlNumbers)
        ' 判断是否为日期格式（可根据实际日期格式补充更多判断）
        If Not (cell.NumberFormat Like "*/*" Or cell.NumberFormat Like "*mmm*" Or cell.NumberFormat Like "*yy*") Then
            cell.Font.Color = RGB(0, 0, 255) ' Blue
        End If
    Next cell
    On Error GoTo 0
    
    ' 处理公式单元格（保持原逻辑，若需要排除特定函数可看方法三）
    On Error Resume Next
    myRange.SpecialCells(xlCellTypeFormulas).Font.Color = RGB(0, 0, 0) ' Black
    On Error GoTo 0
End Sub

方法二：排除带有特定背景色的单元格 #

如果日期单元格有固定的深色背景（比如RGB(50,50,50)），可以直接判断单元格背景色来排除：

Sub FormatCellsBasedOnContent()
    ' color format macro
    Dim myRange As Range
    Dim cell As Range
    
    Set myRange = Selection
    
    ' 处理常量数字单元格，排除指定背景色的单元格
    On Error Resume Next
    For Each cell In myRange.SpecialCells(xlCellTypeConstants, xlNumbers)
        ' 替换成你的日期单元格背景色RGB值
        If cell.Interior.Color <> RGB(50, 50, 50) Then
            cell.Font.Color = RGB(0, 0, 255) ' Blue
        End If
    Next cell
    On Error GoTo 0
    
    ' 处理公式单元格
    On Error Resume Next
    myRange.SpecialCells(xlCellTypeFormulas).Font.Color = RGB(0, 0, 0) ' Black
    On Error GoTo 0
End Sub

方法三：排除包含特定函数的公式单元格 #

如果需要排除使用了EOMONTH/DATE/EDATE的公式单元格，可以检查公式文本：

Sub FormatCellsBasedOnContent()
    ' color format macro
    Dim myRange As Range
    Dim cell As Range
    
    Set myRange = Selection
    
    ' 处理常量数字单元格，排除日期格式
    On Error Resume Next
    For Each cell In myRange.SpecialCells(xlCellTypeConstants, xlNumbers)
        If Not (cell.NumberFormat Like "*/*" Or cell.NumberFormat Like "*mmm*" Or cell.NumberFormat Like "*yy*") Then
            cell.Font.Color = RGB(0, 0, 255) ' Blue
        End If
    Next cell
    On Error GoTo 0
    
    ' 处理公式单元格，排除含特定函数的公式
    On Error Resume Next
    For Each cell In myRange.SpecialCells(xlCellTypeFormulas)
        ' 检查公式是否包含指定函数（不区分大小写）
        If Not (InStr(1, UCase(cell.Formula), "EOMONTH") > 0 Or _
                InStr(1, UCase(cell.Formula), "DATE") > 0 Or _
                InStr(1, UCase(cell.Formula), "EDATE") > 0) Then
            cell.Font.Color = RGB(0, 0, 0) ' Black
        End If
    Next cell
    On Error GoTo 0
End Sub

你之前代码的问题说明 #

1. 循环里用了Selection.NumberFormat而不是cell.NumberFormat，导致判断的是整个选区的格式而非单个单元格
2. Else分支语法错误，一个If只能对应一个Else，你的代码里出现了两个Else

内容的提问来源于stack exchange，提问作者LA1312