设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 求助VBA实现符合条件的字符自动标红
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 392|回复: 6

[已解决]求助VBA实现符合条件的字符自动标红

[复制链接]
发表于 2023-10-19 18:04 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
老师们好！想在表格中实现符合条件的字符自动标红，图一是公式引用过来的数字，想实现成图二中的效果，恳求各位老师帮帮忙写一写VBA代码！
最佳答案
月排行榜 / 总排行榜
林木水123
2023-10-20 17:34
  1. Sub 林demo()
  2. Dim zrr '数字转字符
  3. Dim h As Integer, I As Integer, J As Integer, 一, 二, 三, 四
  4. h = 19
  5. With Sheet1
  6. '++++++++++++++++++转字符
  7.     zrr = .Range("C6:K" & h).Value
  8.     For I = 1 To UBound(zrr)
  9.         For J = 1 To UBound(zrr, 2)
  10.             zrr(I, J) = "'" & zrr(I, J)
  11.         Next
  12.     Next
  13.     .Range("C6:K" & h) = zrr
  14. '+++++++++++++++++++++设置字体颜色
  15. For I = 6 To h
  16.     一 = .Range("C" & I).Characters(1, 1).TEXT
  17.     二 = .Range("C" & I).Characters(2, 1).TEXT
  18.     三 = .Range("C" & I).Characters(3, 1).TEXT
  19.     四 = .Range("C" & I).Characters(4, 1).TEXT
  20.     For J = 1 To 7
  21. '+++++++++++++++++++++D-E设置字体颜色
  22.         If 一 & 四 Like "*" & .Range("D" & I).Characters(J, 1).TEXT & "*" Then
  23.             .Range("D" & I).Characters(J, 1).Font.ColorIndex = 3
  24.         Else
  25.             .Range("D" & I).Characters(J, 1).Font.Color = 1
  26.         End If
  27.         If 一 & 四 Like "*" & .Range("E" & I).Characters(J, 1).TEXT & "*" Then
  28.             .Range("E" & I).Characters(J, 1).Font.ColorIndex = 3
  29.         Else
  30.             .Range("E" & I).Characters(J, 1).Font.Color = 1
  31.         End If
  32. '+++++++++++++++++++++F-G设置字体颜色
  33.         If 二 & 三 Like "*" & .Range("F" & I).Characters(J, 1).TEXT & "*" Then
  34.             .Range("F" & I).Characters(J, 1).Font.ColorIndex = 3
  35.         Else
  36.             .Range("F" & I).Characters(J, 1).Font.Color = 1
  37.         End If
  38.         If 二 & 三 Like "*" & .Range("G" & I).Characters(J, 1).TEXT & "*" Then
  39.             .Range("G" & I).Characters(J, 1).Font.ColorIndex = 3
  40.         Else
  41.             .Range("G" & I).Characters(J, 1).Font.Color = 1
  42.         End If
  43. '+++++++++++++++++++++H-I设置字体颜色
  44.         If 一 & 二 & 三 Like "*" & .Range("H" & I).Characters(J, 1).TEXT & "*" Then
  45.             .Range("H" & I).Characters(J, 1).Font.ColorIndex = 3
  46.         Else
  47.             .Range("H" & I).Characters(J, 1).Font.Color = 1
  48.         End If
  49.         If 一 & 二 & 三 Like "*" & .Range("I" & I).Characters(J, 1).TEXT & "*" Then
  50.             .Range("I" & I).Characters(J, 1).Font.ColorIndex = 3
  51.         Else
  52.             .Range("I" & I).Characters(J, 1).Font.Color = 1
  53.         End If
  54. '+++++++++++++++++++++J-K设置字体颜色
  55.         If 二 & 三 & 四 Like "*" & .Range("J" & I).Characters(J, 1).TEXT & "*" Then
  56.             .Range("J" & I).Characters(J, 1).Font.ColorIndex = 3
  57.         Else
  58.             .Range("J" & I).Characters(J, 1).Font.Color = 1
  59.         End If
  60.         If 二 & 三 & 四 Like "*" & .Range("K" & I).Characters(J, 1).TEXT & "*" Then
  61.             .Range("K" & I).Characters(J, 1).Font.ColorIndex = 3
  62.         Else
  63.             .Range("K" & I).Characters(J, 1).Font.Color = 1
  64.         End If
  65.     Next
  66. Next
  67. End With
  68. End Sub


复制代码
微信图片_20231019175216.png
微信图片_20231019173920.png

工作簿5.rar

39.71 KB, 下载次数: 9
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
发表于 2023-10-20 12:59 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
  1. Sub 林demo()
  2. Dim zrr '数字转字符
  3. Dim h As Integer, I As Integer, J As Integer, 一, 二, 三, 四
  4. h = 19
  5. With Sheet1
  6. '++++++++++++++++++转字符
  7.     zrr = .Range("C6:K" & h).Value
  8.     For I = 1 To UBound(zrr)
  9.         For J = 1 To UBound(zrr, 2)
  10.             zrr(I, J) = "'" & zrr(I, J)
  11.         Next
  12.     Next
  13.     .Range("C6:K" & h) = zrr
  14. '+++++++++++++++++++++设置字体颜色
  15. For I = 6 To h
  16.     一 = .Range("C" & I).Characters(1, 1).TEXT
  17.     二 = .Range("C" & I).Characters(2, 1).TEXT
  18.     三 = .Range("C" & I).Characters(3, 1).TEXT
  19.     四 = .Range("C" & I).Characters(4, 1).TEXT
  20.     For J = 1 To 7
  21. '+++++++++++++++++++++D-E设置字体颜色
  22.         If 一 & 四 Like "*" & .Range("D" & I).Characters(J, 1).TEXT & "*" Then
  23.             .Range("D" & I).Characters(J, 1).Font.ColorIndex = 3
  24.         Else
  25.             .Range("D" & I).Characters(J, 1).Font.Color = 1
  26.         End If
  27.         If 一 & 四 Like "*" & .Range("E" & I).Characters(J, 1).TEXT & "*" Then
  28.             .Range("E" & I).Characters(J, 1).Font.ColorIndex = 3
  29.         Else
  30.             .Range("E" & I).Characters(J, 1).Font.Color = 1
  31.         End If
  32. '+++++++++++++++++++++F-G设置字体颜色
  33.         If 二 & 三 Like "*" & .Range("F" & I).Characters(J, 1).TEXT & "*" Then
  34.             .Range("F" & I).Characters(J, 1).Font.ColorIndex = 3
  35.         Else
  36.             .Range("F" & I).Characters(J, 1).Font.Color = 1
  37.         End If
  38.         If 二 & 三 Like "*" & .Range("G" & I).Characters(J, 1).TEXT & "*" Then
  39.             .Range("G" & I).Characters(J, 1).Font.ColorIndex = 3
  40.         Else
  41.             .Range("G" & I).Characters(J, 1).Font.Color = 1
  42.         End If
  43. '+++++++++++++++++++++H-I设置字体颜色
  44.         If 一 & 二 Like "*" & .Range("H" & I).Characters(J, 1).TEXT & "*" Then
  45.             .Range("H" & I).Characters(J, 1).Font.ColorIndex = 3
  46.         Else
  47.             .Range("H" & I).Characters(J, 1).Font.Color = 1
  48.         End If
  49.         If 一 & 二 Like "*" & .Range("I" & I).Characters(J, 1).TEXT & "*" Then
  50.             .Range("I" & I).Characters(J, 1).Font.ColorIndex = 3
  51.         Else
  52.             .Range("I" & I).Characters(J, 1).Font.Color = 1
  53.         End If
  54. '+++++++++++++++++++++J-K设置字体颜色
  55.         If 二 & 三 Like "*" & .Range("J" & I).Characters(J, 1).TEXT & "*" Then
  56.             .Range("J" & I).Characters(J, 1).Font.ColorIndex = 3
  57.         Else
  58.             .Range("J" & I).Characters(J, 1).Font.Color = 1
  59.         End If
  60.         If 二 & 三 Like "*" & .Range("K" & I).Characters(J, 1).TEXT & "*" Then
  61.             .Range("K" & I).Characters(J, 1).Font.ColorIndex = 3
  62.         Else
  63.             .Range("K" & I).Characters(J, 1).Font.Color = 1
  64.         End If
  65.     Next
  66. Next
  67. End With
  68. End Sub
  69. Sub TEXT()
  70. MsgBox Range("C6").Characters(1, 1).Font.ColorIndex
  71. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2023-10-20 14:14 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
本帖最后由 风飘绝影 于 2023-10-20 14:19 编辑
木水123 发表于 2023-10-20 12:59

谢谢老师，尝试了一下，执行代码的结果如下图，圈起来的都是没标红的 微信图片_20231020141052.png
回复

使用道具 举报

发表于 2023-10-20 17:34 | 显示全部楼层
  1. Sub 林demo()
  2. Dim zrr '数字转字符
  3. Dim h As Integer, I As Integer, J As Integer, 一, 二, 三, 四
  4. h = 19
  5. With Sheet1
  6. '++++++++++++++++++转字符
  7.     zrr = .Range("C6:K" & h).Value
  8.     For I = 1 To UBound(zrr)
  9.         For J = 1 To UBound(zrr, 2)
  10.             zrr(I, J) = "'" & zrr(I, J)
  11.         Next
  12.     Next
  13.     .Range("C6:K" & h) = zrr
  14. '+++++++++++++++++++++设置字体颜色
  15. For I = 6 To h
  16.     一 = .Range("C" & I).Characters(1, 1).TEXT
  17.     二 = .Range("C" & I).Characters(2, 1).TEXT
  18.     三 = .Range("C" & I).Characters(3, 1).TEXT
  19.     四 = .Range("C" & I).Characters(4, 1).TEXT
  20.     For J = 1 To 7
  21. '+++++++++++++++++++++D-E设置字体颜色
  22.         If 一 & 四 Like "*" & .Range("D" & I).Characters(J, 1).TEXT & "*" Then
  23.             .Range("D" & I).Characters(J, 1).Font.ColorIndex = 3
  24.         Else
  25.             .Range("D" & I).Characters(J, 1).Font.Color = 1
  26.         End If
  27.         If 一 & 四 Like "*" & .Range("E" & I).Characters(J, 1).TEXT & "*" Then
  28.             .Range("E" & I).Characters(J, 1).Font.ColorIndex = 3
  29.         Else
  30.             .Range("E" & I).Characters(J, 1).Font.Color = 1
  31.         End If
  32. '+++++++++++++++++++++F-G设置字体颜色
  33.         If 二 & 三 Like "*" & .Range("F" & I).Characters(J, 1).TEXT & "*" Then
  34.             .Range("F" & I).Characters(J, 1).Font.ColorIndex = 3
  35.         Else
  36.             .Range("F" & I).Characters(J, 1).Font.Color = 1
  37.         End If
  38.         If 二 & 三 Like "*" & .Range("G" & I).Characters(J, 1).TEXT & "*" Then
  39.             .Range("G" & I).Characters(J, 1).Font.ColorIndex = 3
  40.         Else
  41.             .Range("G" & I).Characters(J, 1).Font.Color = 1
  42.         End If
  43. '+++++++++++++++++++++H-I设置字体颜色
  44.         If 一 & 二 & 三 Like "*" & .Range("H" & I).Characters(J, 1).TEXT & "*" Then
  45.             .Range("H" & I).Characters(J, 1).Font.ColorIndex = 3
  46.         Else
  47.             .Range("H" & I).Characters(J, 1).Font.Color = 1
  48.         End If
  49.         If 一 & 二 & 三 Like "*" & .Range("I" & I).Characters(J, 1).TEXT & "*" Then
  50.             .Range("I" & I).Characters(J, 1).Font.ColorIndex = 3
  51.         Else
  52.             .Range("I" & I).Characters(J, 1).Font.Color = 1
  53.         End If
  54. '+++++++++++++++++++++J-K设置字体颜色
  55.         If 二 & 三 & 四 Like "*" & .Range("J" & I).Characters(J, 1).TEXT & "*" Then
  56.             .Range("J" & I).Characters(J, 1).Font.ColorIndex = 3
  57.         Else
  58.             .Range("J" & I).Characters(J, 1).Font.Color = 1
  59.         End If
  60.         If 二 & 三 & 四 Like "*" & .Range("K" & I).Characters(J, 1).TEXT & "*" Then
  61.             .Range("K" & I).Characters(J, 1).Font.ColorIndex = 3
  62.         Else
  63.             .Range("K" & I).Characters(J, 1).Font.Color = 1
  64.         End If
  65.     Next
  66. Next
  67. End With
  68. End Sub


复制代码
回复

使用道具 举报

发表于 2023-10-20 17:34 | 显示全部楼层    本楼为最佳答案   
  1. Sub 林demo()
  2. Dim zrr '数字转字符
  3. Dim h As Integer, I As Integer, J As Integer, 一, 二, 三, 四
  4. h = 19
  5. With Sheet1
  6. '++++++++++++++++++转字符
  7.     zrr = .Range("C6:K" & h).Value
  8.     For I = 1 To UBound(zrr)
  9.         For J = 1 To UBound(zrr, 2)
  10.             zrr(I, J) = "'" & zrr(I, J)
  11.         Next
  12.     Next
  13.     .Range("C6:K" & h) = zrr
  14. '+++++++++++++++++++++设置字体颜色
  15. For I = 6 To h
  16.     一 = .Range("C" & I).Characters(1, 1).TEXT
  17.     二 = .Range("C" & I).Characters(2, 1).TEXT
  18.     三 = .Range("C" & I).Characters(3, 1).TEXT
  19.     四 = .Range("C" & I).Characters(4, 1).TEXT
  20.     For J = 1 To 7
  21. '+++++++++++++++++++++D-E设置字体颜色
  22.         If 一 & 四 Like "*" & .Range("D" & I).Characters(J, 1).TEXT & "*" Then
  23.             .Range("D" & I).Characters(J, 1).Font.ColorIndex = 3
  24.         Else
  25.             .Range("D" & I).Characters(J, 1).Font.Color = 1
  26.         End If
  27.         If 一 & 四 Like "*" & .Range("E" & I).Characters(J, 1).TEXT & "*" Then
  28.             .Range("E" & I).Characters(J, 1).Font.ColorIndex = 3
  29.         Else
  30.             .Range("E" & I).Characters(J, 1).Font.Color = 1
  31.         End If
  32. '+++++++++++++++++++++F-G设置字体颜色
  33.         If 二 & 三 Like "*" & .Range("F" & I).Characters(J, 1).TEXT & "*" Then
  34.             .Range("F" & I).Characters(J, 1).Font.ColorIndex = 3
  35.         Else
  36.             .Range("F" & I).Characters(J, 1).Font.Color = 1
  37.         End If
  38.         If 二 & 三 Like "*" & .Range("G" & I).Characters(J, 1).TEXT & "*" Then
  39.             .Range("G" & I).Characters(J, 1).Font.ColorIndex = 3
  40.         Else
  41.             .Range("G" & I).Characters(J, 1).Font.Color = 1
  42.         End If
  43. '+++++++++++++++++++++H-I设置字体颜色
  44.         If 一 & 二 & 三 Like "*" & .Range("H" & I).Characters(J, 1).TEXT & "*" Then
  45.             .Range("H" & I).Characters(J, 1).Font.ColorIndex = 3
  46.         Else
  47.             .Range("H" & I).Characters(J, 1).Font.Color = 1
  48.         End If
  49.         If 一 & 二 & 三 Like "*" & .Range("I" & I).Characters(J, 1).TEXT & "*" Then
  50.             .Range("I" & I).Characters(J, 1).Font.ColorIndex = 3
  51.         Else
  52.             .Range("I" & I).Characters(J, 1).Font.Color = 1
  53.         End If
  54. '+++++++++++++++++++++J-K设置字体颜色
  55.         If 二 & 三 & 四 Like "*" & .Range("J" & I).Characters(J, 1).TEXT & "*" Then
  56.             .Range("J" & I).Characters(J, 1).Font.ColorIndex = 3
  57.         Else
  58.             .Range("J" & I).Characters(J, 1).Font.Color = 1
  59.         End If
  60.         If 二 & 三 & 四 Like "*" & .Range("K" & I).Characters(J, 1).TEXT & "*" Then
  61.             .Range("K" & I).Characters(J, 1).Font.ColorIndex = 3
  62.         Else
  63.             .Range("K" & I).Characters(J, 1).Font.Color = 1
  64.         End If
  65.     Next
  66. Next
  67. End With
  68. End Sub


复制代码
回复

使用道具 举报

发表于 2023-10-20 17:37 | 显示全部楼层
风飘绝影 发表于 2023-10-20 14:14
谢谢老师，尝试了一下，执行代码的结果如下图，圈起来的都是没标红的

条件看错了。
回复

使用道具 举报

 楼主| 发表于 2023-10-20 18:51 | 显示全部楼层
林木水123 发表于 2023-10-20 17:37
条件看错了。

谢谢老师，老师辛苦了！
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-4-27 22:27 , Processed in 0.169749 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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