[已解决]请教数字改变颜色问题

yvll · 发表于 2021-9-23 13:05

请教数字改变颜色问题，谢谢！

数字变色.rar (8.64 KB, 下载次数: 5)

cutecpu · 发表于 2021-9-23 14:48

这个最佳答案由 cutecpu 给出，感谢 cutecpu 的回答。

单击隐藏图章

祝順心，南無阿彌陀佛！

lisongmei · 发表于 2021-9-23 15:27

Sub c_color()
Dim x, k, j, i, yyy, m As Integer
Dim rust, str_ru As Match
Dim sr, srr, ss As String
Dim yy As Range
Dim reg As New RegExp
Dim arr1
'重置格式
Columns("AD:AI").Font.ThemeColor = xlThemeColorLight1
Columns("AD:AI").Font.Bold = False
x = Range("i10000").End(xlUp).Row '数据区域最末行
k = 0
With reg
.Global = True
.Pattern = "\d{2}"
For i = 2 To x '对数据区域每一行循环
ReDim arr1(1 To 1)
For Each yy In Range(Cells(i, 9), Cells(i, 28))
k = k + 1
ReDim Preserve arr1(1 To k)
arr1(k) = yy.Value
Next
srr = VBA.Join(arr1, "-") '数据区域的每一行联合成字符串
For j = [ad2].Column To [ai2].Column '对结果区域循环
sr = Cells(i, j).Value
If .Test(sr) Then ' 若匹配成功，执行
Set rust = .Execute(sr)
For Each str_ru In rust
ss = str_ru.Value
yyy = str_ru.FirstIndex '每个数字的位置
m = VBA.InStr(1, srr, ss) '查询在数据区域是否存在
If m > 0 Then '若存在，设置字的颜色为红+加粗
Cells(i, j).Characters(yyy + 1, 2).Font.ColorIndex = 3 'yyy下标是从0开始，所以加1
Cells(i, j).Characters(yyy + 1, 2).Font.Bold = True
End If
Next
End If
Next
Erase arr1 '重置数组
k = 0 '重置计数
Next
End With
End Sub

复制代码

yvll · 发表于 2021-9-23 15:31

cutecpu 发表于 2021-9-23 14:48
祝順心，南無阿彌陀佛！

非常非常好，感谢您！

yvll · 发表于 2021-9-23 15:42

lisongmei 发表于 2021-9-23 15:27

谢谢您。运行时有错误

lisongmei · 发表于 2021-9-23 15:55

yvll 发表于 2021-9-23 15:42
谢谢您。运行时有错误

不好意思，忘了你们表格一般没加载正则模块了

Dim reg As New RegExp
Dim rust, str_ru As Match
若要运行，需把上面两句换成下面两句
Dim rust, str_ru,reg
Set reg = CreateObject("vbscript.regexp")

yvll · 发表于 2021-10-19 22:53

cutecpu 发表于 2021-9-23 14:48
祝順心，南無阿彌陀佛！

cutecpu老师您好，在使用过程中发现，如果数据是由公式产生的，就得不到正确的结果，请您抽时间看看，谢谢您！

颜色问题 (1).rar (21.87 KB, 下载次数: 1)

cutecpu · 发表于 2021-10-20 12:44

yvll 发表于 2021-10-19 22:53
cutecpu老师您好，在使用过程中发现，如果数据是由公式产生的，就得不到正确的结果，请您抽时间看看，谢 ...

您好，

1. 在含有公式的单元格，Range.Characters 属性可能没办法如期应用
看看其他大侠有没有办法

2. 另一种解决方案就是，把公式的逻辑也写在 VBA (填满 AD ~ AI 列)

yvll · 发表于 2021-10-20 16:01

cutecpu 发表于 2021-10-20 12:44
您好，

谢谢您，我再发帖其其他老师帮助一下。

		自动登录	找回密码
密码			注册

[已解决]请教数字改变颜色问题

评分

评分

点评