excel - 如何更改 Variant excel VBA 上的字体颜色?
问题描述
我有一些代码采用诸如 <0.2 之类的单元格值并丢弃“小于”符号并返回数字部分的一半,例如 0.1
这很好用,但我想通过将字体颜色设为红色来指示已更改的单元格。
我无法应用格式。我在下面的代码上尝试了一些变体,但在格式化行上得到了一个运行时错误 424 对象。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```
解决方案
请尝试下一个改编的代码。您的代码使用数组,这在速度方面还不错,但它不处理具有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
推荐阅读
- oracle - Oracle JDBC Resultset.getString("COLUMN_DEF") 返回小写引号字符串
- configuration - 在 kube-apiserver 中设置功能门 RuntimeClass
- reactjs - 如何从我的示例中使 React 组件看起来更具可读性和简洁性?
- excel - Excel:计算员工一周内一起工作的频率?
- regex - 正则表达式:文件名中的否定模式
- java - 从 MYSQL 获取基于用户 ID 的数据并显示在 android studio 的 recyclerview 中
- java - 需要一个找不到的“org.springframework.mail.javamail.JavaMailSender”类型的bean,但给出了配置
- php - 显示没有 css 和 js 的索引页面
- android - Android App Link verify 一直不起作用
- php - 哪一个是最好和更快的方法?(制作下拉方法)