如何更改变体 excel VBA 上的字体颜色？

Question

我有一些代码采用诸如 <0.2 之类的单元格值并丢弃“小于”符号并返回数字部分的一半，例如 0.1

这很好用，但我想通过将字体颜色设为红色来指示已更改的单元格。

我无法应用格式。 我尝试了以下代码的一些变体，但在格式化行上出现运行时错误 424 object required。 MyVar = MyVar.Font.ColorIndex = 3

Sub RemoveLessThanSpedUp()
'
'
'Values with Red Text were reported as less than the method detection limit and are shown here as one-half the detection limit
'
Dim r As Range
Dim Datarange As Variant
Dim Irow As Integer
Dim MaxRows As Long
Dim Icol As Integer
Dim MaxCols As Long
Dim MyVar As Variant

Datarange = Range("A1").CurrentRegion.Value
MaxRows = Range("A1").CurrentRegion.Rows.Count
MaxCols = Range("A1").CurrentRegion.Columns.Count
    For Irow = 1 To MaxRows
        For Icol = 1 To MaxCols
            MyVar = Datarange(Irow, Icol)
            If Left(MyVar, 1) = "<" Then
            MyVar = (Right(MyVar, Len(MyVar) - 1)) / 2
            MyVar = MyVar.Characters.ColorIndex = 3
            'MyVar.Font.ColorIndex = 3
            Datarange(Irow, Icol) = MyVar
            
            End If
        
    Next Icol
    Next Irow
Range("A1").CurrentRegion = Datarange
End Sub```

Answer 1

请尝试下一个改编的代码。 您的代码使用数组，这在速度方面还不错，但它不处理具有font属性的范围。 为许多细胞着色可能需要很长时间。 我将构建一个数组以填充修改后的单元格地址，该数组将被删除到现有单元格之后的第一列：

Sub RemoveLessThanSpedUp()
Dim r As Range, Datarange As Variant, Irow As Integer
Dim MaxCols As Long, MyVar As Variant, MaxRows As Long, Icol As Long
Dim sh As Worksheet, i As Long, arrEr, k As Long

Set sh = ActiveSheet 'use here what you need

MaxRows = sh.Range("A1").CurrentRegion.Rows.Count
MaxCols = sh.Range("A1").CurrentRegion.Columns.Count
If sh.Cells(1, MaxCols).Value = "Errors" Then
    sh.Cells(1, MaxCols).EntireColumn.Clear
    MaxCols = MaxCols - 1
End If
Datarange = sh.Range("A1").CurrentRegion.Value
ReDim arrEr(MaxRows * MaxCols)
    For Irow = 1 To MaxRows
        For Icol = 1 To MaxCols
            i = i + 1
            MyVar = Datarange(Irow, Icol)
            If Left(MyVar, 1) = "<" Then
                MyVar = (Right(MyVar, Len(MyVar) - 1)) / 2
                arrEr(k) = sh.Cells(Irow, Icol).Address(0, 0): k = k + 1
                Datarange(Irow, Icol) = MyVar
            End If
        Next Icol
    Next Irow
    
    If k > 0 Then
        ReDim Preserve arrEr(k - 1)
        sh.Range("A1").CurrentRegion = Datarange
        With sh.Cells(2, MaxCols + 1)
            .Offset(-1).Value = "Errors"
            .Resize(k, 1).Value = Application.Transpose(arrEr)
        End With
    Else
        MsgBox "Nothing to be corrected..."
    End If
End Sub