请老师帮忙改善和提升数据对比的代码

divineson · 发表于 2024-11-17 11:52

本帖最后由 divineson 于 2024-11-17 11:59 编辑

自己胡编乱改，做出了一个数据对比的代码，主要作用就是A列与B列的数据的横向对比，即A2与B2、A3与B3，以此类推，A、B两个单元格内有不同的进行相向标红字，但效果不太好，特别是文字比较长的或开头文字相同但后面不同的都没有标注出来，还有一个缺陷就是对比过一次后，原来有数据的进行了增加，也不会再进行对比了，请老师帮忙看看如何改善和提升效果，谢谢！

shiruiqiang · 发表于 2024-11-17 13:41

本帖最后由 shiruiqiang 于 2024-11-17 14:13 编辑

个人建议：一开始，需代码把a列的字体颜色修改为黑色，否则后台再比较，体现不出来
第二，你的正则式只是提取了汉字部分，应该是一段。

divineson · 发表于 2024-11-17 14:17

shiruiqiang 发表于 2024-11-17 13:41
个人建议：一开始，需代码把a列的字体颜色修改为黑色，否则后台再比较，体现不出来
第二，你的正则式只是 ...

老师你好，能麻烦你帮忙把代码完善吗？之前自己摸索了很久也做不出想要的结果，因工作关系现在急需使用，谢谢老师！

shiruiqiang · 发表于 2024-11-17 14:41

模块2，红色的为相同，黑色的为不同
你要改红色的不同，代码先修改为一开始为红色，相同的变成黑色

shiruiqiang · 发表于 2024-11-17 15:59

如果正则式，应该是这样写“[^\、]+”

divineson · 发表于 2024-11-17 16:13

shiruiqiang 发表于 2024-11-17 14:41
模块2，红色的为相同，黑色的为不同
你要改红色的不同，代码先修改为一开始为红色，相同的变成黑色

感谢老师的帮忙，请教一下能改为通用的吗？即放在哪个子表加载都能使用，目前只能在“sheet1"中使用；另外，我是想做成双向的对比的效果，如下图，这样比较直观，能一眼看出不同的地方向，麻烦老师再帮忙改改，万分感激！

divineson · 发表于 2024-11-17 16:21

shiruiqiang 发表于 2024-11-17 15:59
如果正则式，应该是这样写“[^\、]+”

按照老师提供的代码改了，但我这里显示不成功

divineson · 发表于 2024-11-17 16:32

shiruiqiang 发表于 2024-11-17 15:59
如果正则式，应该是这样写“[^\、]+”

不好意思，是我没用对符号，老师的改法是正确的，已经成功。还想请教一下，如何改为每次运行先清除原来的结果，将字体重新都改为黑色后再次进行对比。正则使用后，发现如果我手动在A列或B列再手工输入一些数据再做检测好像结果就不会变了。

shiruiqiang · 发表于 2024-11-17 16:33

你把附件发上来，顿号有中英文大小写的问题

ynzsvt · 发表于 2024-11-17 16:43

Sub 对比3()
Dim ss As Range
Dim ss1 As Range
Set reg = CreateObject("vbscript.regexp")
Set reg1 = CreateObject("vbscript.regexp")
pat = "[^、]+"
With reg
.Global = True
.Pattern = pat ' "[一-龢]+"
For Each ss In Range("b2", Cells(Rows.Count, 2).End(xlUp))
Set sj = .Execute(ss)
For Each xm In sj
If Not "、" & ss.Offset(0, -1) & "、" Like "*、" & xm & "、*" Then
qd = xm.firstindex + 1
cd = xm.Length
ss.Characters(qd, cd).Font.Color = 255
End If
Next xm
Next ss
End With
With reg1
.Global = True
.Pattern = pat ' "[一-龢]+"
For Each ss1 In Range("a2", Cells(Rows.Count, 1).End(xlUp))
Set sj1 = .Execute(ss1)
For Each xm1 In sj1
If Not "、" & ss1.Offset(0, 1) & "、" Like "*、" & xm1 & "、*" Then
qd1 = xm1.firstindex + 1
cd1 = xm1.Length
ss1.Characters(qd1, cd1).Font.Color = 255
End If
Next xm1
Next ss1
End With
End Sub

复制代码

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

[求助] 请老师帮忙改善和提升数据对比的代码

评分

评分

浏览过的版块