Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

工作中常用的Excel函数公式,全印在一张超大鼠标垫上
查看: 138|回复: 6

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

[复制链接]
发表于 2021-9-23 13:05 | 显示全部楼层 |阅读模式
请教数字改变颜色问题,谢谢!
数字变色.rar (8.64 KB, 下载次数: 5)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2021-9-23 14:48 | 显示全部楼层    本楼为最佳答案   
祝順心,南無阿彌陀佛!

颜色问题.rar

16.22 KB, 下载次数: 5

评分

参与人数 1学分 +2 收起 理由
yvll + 2 太强大了

查看全部评分

回复

使用道具 举报

发表于 2021-9-23 15:27 | 显示全部楼层
  1. Sub c_color()
  2. Dim x, k, j, i, yyy, m As Integer
  3. Dim rust, str_ru As Match
  4. Dim sr, srr, ss As String
  5. Dim yy As Range
  6. Dim reg As New RegExp
  7. Dim arr1
  8. '重置格式
  9. Columns("AD:AI").Font.ThemeColor = xlThemeColorLight1
  10. Columns("AD:AI").Font.Bold = False
  11. x = Range("i10000").End(xlUp).Row '数据区域最末行
  12. k = 0
  13. With reg
  14.     .Global = True
  15.     .Pattern = "\d{2}"
  16. For i = 2 To x '对数据区域每一行循环
  17.     ReDim arr1(1 To 1)
  18.     For Each yy In Range(Cells(i, 9), Cells(i, 28))
  19.         k = k + 1
  20.         ReDim Preserve arr1(1 To k)
  21.         arr1(k) = yy.Value
  22.     Next
  23.     srr = VBA.Join(arr1, "-") '数据区域的每一行联合成字符串
  24.     For j = [ad2].Column To [ai2].Column '对结果区域循环
  25.         sr = Cells(i, j).Value
  26.         If .Test(sr) Then ' 若匹配成功,执行
  27.             Set rust = .Execute(sr)
  28.             For Each str_ru In rust
  29.                 ss = str_ru.Value
  30.                 yyy = str_ru.FirstIndex '每个数字的位置
  31.                 m = VBA.InStr(1, srr, ss) '查询在数据区域是否存在
  32.                 If m > 0 Then '若存在,设置字的颜色为红+加粗
  33.                     Cells(i, j).Characters(yyy + 1, 2).Font.ColorIndex = 3 'yyy下标是从0开始,所以加1
  34.                     Cells(i, j).Characters(yyy + 1, 2).Font.Bold = True
  35.                 End If
  36.             Next
  37.         End If
  38.     Next
  39.     Erase arr1 '重置数组
  40.     k = 0 '重置计数
  41. Next
  42. End With
  43. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2021-9-23 15:31 | 显示全部楼层
cutecpu 发表于 2021-9-23 14:48
祝順心,南無阿彌陀佛!

非常非常好,感谢您!

评分

参与人数 1学分 +2 收起 理由
cutecpu + 2 不客气。祝顺心,南无阿弥陀佛!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2021-9-23 15:42 | 显示全部楼层

谢谢您。运行时有错误 5.JPG



回复

使用道具 举报

发表于 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")

回复

使用道具 举报

 楼主| 发表于 2021-10-19 22:53 | 显示全部楼层
cutecpu 发表于 2021-9-23 14:48
祝順心,南無阿彌陀佛!

cutecpu老师您好,在使用过程中发现,如果数据是由公式产生的,就得不到正确的结果,请您抽时间看看,谢谢您!
颜色问题 (1).rar (21.87 KB, 下载次数: 1)
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2021-10-20 08:46 , Processed in 1.607414 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表