楼主
kevinchengcw |
Q: 如何利用vba代码，让预设单元格中符合预设条件的数字变成预定颜色？
A: 代码如下：
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim Rng As Range, N&, mMatch, mColor
- For Each Rng In Target '循环目标区域各个单元格(方便处理粘贴等多单元格情况)
- If Not Intersect([b2:b3], Rng) Is Nothing Then '如果当前循环到的单元格处在目标区域内,则
- With CreateObject("vbscript.regexp") '创建正则项目
- .Global = True '全局有效
- .Pattern = "\d+" '提取数字
- If Rng <> "" Then '如果单元格不为空,则
- For Each mMatch In .Execute(Rng.Value) '循环匹配到的内容(如果未匹配到内容会自动跳过,不会报错)
- If InStr(",01,02,07,08,12,13,18,19,23,24,", "," & mMatch.Value & ",") > 0 Then '判断取得的数字对应预设条件,从而取得预设颜色
- mColor = vbRed
- ElseIf InStr(",03,04,09,10,14,15,20,25,", "," & mMatch.Value & ",") > 0 Then
- mColor = vbBlue
- Else
- mColor = vbGreen
- End If
- N = InStr(Rng.Value, mMatch.Value) '取得第一个符合的数字所处位置
- Do While InStr(N, Rng.Value, mMatch.Value) <> 0 '当可以继续找到时继续循环
- Rng.Characters(N, Len(mMatch.Value)).Font.Color = mColor '将对应位置的字符串变成预设颜色
- N = N + Len(mMatch.Value) '查找的初始位置后移
- Loop
- Next mMatch
- End If
- End With
- End If
- Next Rng
- End Sub
详见素材源帖. |
