Excel 我的代码取一个空白单元格，并将其调整为“0”；空的“；，将文本变为红色最有效的方法是什么？

我的整个代码相当大，需要处理大量数据。为了节省时间，我需要尽可能高效。对于下面的代码，在没有新行/if语句的情况下，如何将文本颜色变为红色

我知道我可以执行另一个if语句，但这需要宝贵的时间，而且我担心在运行代码20分钟后会出错

For Each r In Intersect(newbook.Sheets("Sheet1").Range("AQ:AQ"),   newbook.Sheets("Sheet1").UsedRange)
If IsEmpty(r.Value2) Or Trim(r.Value2) = "" Then
  'below is the line/cell I need to make red
 r.Value2 = "Empty"

---

我添加了一行代码来将文本变成红色。 既然您提到希望代码尽快运行，我希望您熟悉

Application.Calculation=xlManual

和

Application.screenupdate=False

等

您可以做的另一件事是将工作表存储到数组中，并在内存中操作，而不是直接在工作表上操作

For Each r In Intersect(newbook.Sheets("Sheet1").Range("AQ:AQ"), _ 
              newbook.Sheets("Sheet1").UsedRange)

    If IsEmpty(r.Value2) Or Trim(r.Value2) = "" Then
        r.Value2 = "Empty"
        'The line below will change the font color to red
        r.Cells.Font.ColorIndex = 3

---

要提高程序的效率，请在程序开头添加以下行：

    With Application
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

在它的结尾：

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With

另外，建议使用一种方法，而不是一个单元格一个单元格地处理范围，即设置一个包含所有必需的

单元格的
范围
，并同时更新
值
和
字体颜色

根据您想要实现的目标，使用以下方法之一：

获取所有“空”的
单元格
，不包括那些包含返回
的公式或值等于
的单元格
；使用。此方法由函数
SpecialCells_402;MarkAs_Empty

要获取所有“空的”
单元格
，包括那些值等于
“
的单元格，并排除那些包含返回
”
的公式的单元格；与
LookIn:=xlFormulas
一起使用。此方法由函数
FindCells_402;MarkAs_Empty

要获取所有“空的”
单元格
，包括值等于
“
的单元格和包含返回
”
公式的单元格；与
LookIn:=xlValues
一起使用。此方法由函数
FindCells_402;MarkAs_Empty

使用过程
Cells\u MarkAs\u Empty
调用所需的方法。该程序应称为：

Call Cells_MarkAs_Empty(bMethod)

其中
b方法
是从1到3的整数，表示要应用的方法

1.特殊电池

2.查找（LookIn:=xlFormulas）

3.查找（查找：=xlValues）


有关所用资源的详细信息，请查看以下页面：









只需对范围使用条件格式即可。选择规则类型仅格式化包含的单元格，然后使用空格仅格式化单元格感谢您的帮助！根据你在手术前后说的话。。。这仅仅是在这个子程序中，还是在我的主子程序中，我调用了其余的子程序？这是在主子程序中。但是，当任何程序使用公式的结果时，必须小心，然后必须确保所取的值是更新的。网络上有很多关于这个主题的信息，请尝试：@EEM FYI
SpecialCells（xlcelltypebanks）
不捕获一些
Trim（r.Value2）=“将，例如返回空字符串的公式。谢谢@chrisneilsen将在一分钟内更新代码。如果我使用上面提到的两个公式，会出现什么问题？很抱歉，我一直在学习，因为我创造了这个，这些都是新的，你不会期望任何问题。在主代码之前禁用
屏幕更新
，在主代码之后立即启用。唯一的问题是，您不会看到宏如何更改工作表，但这正是问题所在……这就是为什么它会运行得更快。
Sub Cells_MarkAs_Empty(bMethod As Byte)
Rem bMethod: whole number from 1 to 3
Rem Method 1: SpecialCells
Rem Method 2: Find (LookIn:=xlFormulas)
Rem Method 3: Find (LookIn:=xlValues)
Dim rSrc As Range, rTrg As Range

    Rem Validate Input
    If bMethod < 1 Or bMethod > 3 Then
        MsgBox "Method: " & bMethod & " is invalid!"
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Rem Set Source Range
    With ThisWorkbook.Sheets("DATA")
        Set rSrc = Intersect(.Range("J:J"), .UsedRange)
    End With

    Select Case bMethod
    Case 1:     Set rTrg = SpecialCells_ƒMarkAs_Empty(rSrc)
    Case 2:     Set rTrg = FindCells_ƒMarkAs_Empty(rSrc, xlFormulas)
    Case 3:     Set rTrg = FindCells_ƒMarkAs_Empty(rSrc, xlValues)
    End Select

    Rem Mark Target Range
    If Not (rTrg Is Nothing) Then
        With rTrg
            .Value2 = "Empty"
            .Font.Color = RGB(255, 0, 0)
    End With: End If

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With

    End Sub

Function SpecialCells_ƒMarkAs_Empty(rSrc As Range) As Range
    On Error Resume Next
    Set SpecialCells_ƒMarkAs_Empty = rSrc.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    End Function

Function FindCells_ƒMarkAs_Empty(rSrc As Range, vLookIn As Variant) As Range
Const kWhat As String = ""
Dim rFnd As Range, rCll As Range, s1st As String

    With rSrc

        Set rCll = .Find(What:=kWhat, _
            After:=.Cells(.Cells.Count), _
            LookIn:=vLookIn, LookAt:=xlWhole, _
            SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

        If Not (rCll Is Nothing) Then

            s1st = rCll.Address
            Set rFnd = rCll

            Do
                Set rCll = .FindNext(After:=rCll)
                If rCll.Address = s1st Then Exit Do
                Set rFnd = Union(rFnd, rCll)
            Loop Until rCll.Address = s1st

    End If: End With

    Rem Set Results
    Set FindCells_ƒMarkAs_Empty = rFnd

    End Function