作者：绿色风
分类：
时间：2022-08-17
浏览：125
楼主
liuguansky |
Q:如何把单元格中以","分隔的内容的以相同的字体颜色和加粗进行标示.不同的重复值以不同的颜色标示.
A:用如下代码可以实现:
- Sub justtest()
- Dim arr, i&, d, ar, j%, k&, s% '定义变量
- Set d = CreateObject("scripting.dictionary") '创建字典项目,用于存放颜色值
- Application.ScreenUpdating = False '关闭屏幕刷新
- With Range([l6], [l6].End(4)) '获取目标区域
- .Font.Color = xlblack '初始字体颜色
- .Font.Bold = False '初始粗体
- arr = .Value '赋值数组
- End With '结束获取对象
- For i = 1 To UBound(arr, 1) '循环数组
- ar = Split(arr(i, 1), ",") '分隔出各子项,赋值予数组
- For j = 0 To UBound(ar) '循环子项数组
- If d.Exists(ar(j)) Then '判断是否重复,如果重复生成相同的随机颜色值
- If d(ar(j)) = 0 Then
- s = Int(j * 15 + Rnd() * 14) Mod 56 + 1
- If s = 2 Or s = 20 Or s = 34 Then s = s + 1
- d(ar(j)) = s
- End If
- Else: d.Add ar(j), 0
- End If
- Next j
- Next i
- For i = 1 To UBound(arr, 1) '第二值循环
- ar = Split(arr(i, 1), ",")
- s = 0 '初始化字符长度标识符
- For j = 0 To UBound(ar)
- If d(ar(j)) > 0 Then '如果重复
- k = k + 1
- With Range("l" & i + 5).Characters(s + 1, Len(ar(j))).Font '进行相应子项颜色标记
- .Bold = True
- .ColorIndex = d(ar(j))
- End With
- End If
- s = s + Len(ar(j)) + 1 '字符长度累加
- Next j
- Next i
- If k = 0 Then
- MsgBox ("如果出现此提示框，说明：" & Chr(10) & "没有发现重复项")
- Else
- MsgBox ("如果出现此提示框，说明：" & Chr(10) & "发现 " & k & " 处重复项，请 进 一步确认BOM")
- End If
- Application.ScreenUpdating = True
- Set d = Nothing
- End Sub
|
2楼
nzkboy |
呵呵，前段时间才经常登陆此网站，没想到发了5个贴后就被收录了2贴，不容易呀 |
3楼
nzkboy |
根据老师的方案，我在下面增加了几行代码，提示重复的内容多少的，这样让操作者更容易判断，否则个别标识成黄色或是内容多的可能不容易被区别出来，所以增加一个判断的步骤。
If k = 0 Then
MsgBox ("如果出现此提示框，说明：" & Chr(10) & "没有发现重复项")
Else
MsgBox ("如果出现此提示框，说明：" & Chr(10) & "发现 " & k & " 处重复项，请 进 一步确认BOM")
End If
另外说一步，老师的第38步应该是
Application.ScreenUpdating = True '开启屏幕刷新 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一