VBA宏获取Font.ColorIndex返回负值及速度关联问题求助

这绝对是个让人挠头的VBA怪问题，我帮你拆解清楚：

为什么会出现负数？ #

你观察到的-5、-7这些值不是随机的，它们是Excel内部的临时占位标记。当你全速运行宏时，Excel在快速遍历大量单元格时，可能还没来得及完全解析单元格的格式信息，就返回了这些临时值；而调试慢步执行时，Excel有足够时间完成格式解析，所以能返回正确的ColorIndex（比如红色3、黑色1）。你发现的8-5=3、8-7=1也验证了这一点——这些负数是Excel用8 - 正确索引的方式临时存储的未解析值。

这个现象不正常，属于Excel在高频率访问单元格格式时的缓存/解析延迟bug，和你的变量类型、单元格格式没关系。

解决方案 #

1. 临时“减速”：强制Excel完成格式解析 #

如果不想大改代码，可以在每次读取ColorIndex后，让Excel处理完pending的操作，用DoEvents或者强制刷新屏幕：

Sub FontMacroSlowFix()
    Dim I As Long
    Dim FontCol As Long
    '如果之前关了屏幕更新，临时打开帮助解析
    Dim originalScreenUpdating As Boolean
    originalScreenUpdating = Application.ScreenUpdating
    Application.ScreenUpdating = True
    
    For I = 36 To 51
        FontCol = Cells(I, 10).Font.ColorIndex
        DoEvents '让Excel处理完格式解析
        If FontCol = 3 Then
            Cells(I, 18) = "Red"
            Cells(I, 19) = FontCol
        Else
            Cells(I, 18) = "Not Red"
            Cells(I, 19) = FontCol
        End If
    Next I
    
    '恢复原来的屏幕更新设置
    Application.ScreenUpdating = originalScreenUpdating
End Sub

不过注意：DoEvents会让宏响应其他Excel操作，对于46000+行的表格，这个方法会很慢，适合小范围测试。

2. 高效方案：一次性读取格式数组（推荐） #

逐行访问单元格是VBA里最耗时的操作之一，也是触发这个bug的根源。我们可以一次性把整个目标区域的ColorIndex读到内存数组里，处理完再一次性写入结果，既避免了缓存问题，又大幅提升速度：

Sub FontMacroHighEfficiency()
    Dim ws As Worksheet
    Set ws = ActiveSheet '换成你的工作表，比如ThisWorkbook.Sheets("DataSheet")
    
    Dim targetStartRow As Long, targetEndRow As Long
    targetStartRow = 36
    targetEndRow = ws.Cells(ws.Rows.Count, 10).End(xlUp).Row '自动获取第10列最后一行
    
    '一次性读取目标列的ColorIndex到数组
    Dim colorArr As Variant
    colorArr = ws.Range(ws.Cells(targetStartRow, 10), ws.Cells(targetEndRow, 10)).Font.ColorIndex
    
    '准备结果数组
    Dim textResultArr As Variant, colorResultArr As Variant
    ReDim textResultArr(1 To UBound(colorArr, 1), 1 To 1)
    ReDim colorResultArr(1 To UBound(colorArr, 1), 1 To 1)
    
    '内存中处理数据
    Dim i As Long
    For i = 1 To UBound(colorArr, 1)
        If colorArr(i, 1) = 3 Then
            textResultArr(i, 1) = "Red"
            colorResultArr(i, 1) = colorArr(i, 1)
        Else
            textResultArr(i, 1) = "Not Red"
            colorResultArr(i, 1) = colorArr(i, 1)
        End If
    Next i
    
    '一次性写入结果
    ws.Range(ws.Cells(targetStartRow, 18), ws.Cells(targetEndRow, 18)).Value = textResultArr
    ws.Range(ws.Cells(targetStartRow, 19), ws.Cells(targetEndRow, 19)).Value = colorResultArr
End Sub

这个方法对46000+行的表格来说，速度会提升几十甚至上百倍，同时彻底避免了格式解析延迟的问题。

3. 辅助优化：关闭后台计算 #

如果你的表格有大量公式，Excel的后台重新计算可能会和宏运行抢资源，导致格式解析延迟。可以临时关闭计算：

Sub FontMacroWithCalcFix()
    Dim originalCalc As XlCalculation
    originalCalc = Application.Calculation
    Application.Calculation = xlCalculationManual '临时关闭自动计算
    
    '这里放你的宏代码（高效版或减速版）
    
    Application.Calculation = originalCalc '恢复自动计算
End Sub

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