恳请您伸出援手指导指导，不胜感激！！！！！！

李元聪

工作中遇到Excel问题了，生意难做，不能去过多的要求客户，只能选择去适应，不会就只有虚心请教，望伸手援助!谢谢！

taller

ykcbf1100

我觉得，客户的表数据结构更合理，楼主应该去适合客户。

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.2.22
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("我的表")
   
4.         .Cells.Font.ColorIndex = 0
   
5.         r = .Cells(Rows.Count, 4).End(3).Row
   
6.         arr = .Range("d3:d" & r)
   
7.         For i = 1 To UBound(arr)
   
8.             s = CStr(arr(i, 1))
   
9.             d(s) = ""
   
10.         Next
    
11.         r = .Cells(Rows.Count, 1).End(3).Row
    
12.         arr = .Range("a1:a" & r)
    
13.         For i = 3 To UBound(arr)
    
14.             st = CStr(arr(i, 1))
    
15.             b = Split(st, ",")
    
16.             For x = 0 To UBound(b)
    
17.                 s = b(x)
    
18.                 If Not d.exists(s) Then
    
19.                     l = InStr(.Cells(i, 1), s)
    
20.                     With .Cells(i, 1).Characters(l, Len(s)).Font
    
21.                         .Color = RGB(255, 0, 0) ' 红色
    
22.                     End With
    
23.                 End If
    
24.             Next
    
25.         Next
    
26.     End With
    
27.     MsgBox "OK！"
    
28. End Sub
    

复制代码

李元聪

ykcbf1100 发表于 2024-2-22 07:50
我觉得，客户的表数据结构更合理，楼主应该去适合客户。

附件供参考。。。

谢谢，可怜的是我的表也是来源于上游甲方，我在中间环节，难呀…

李元聪

taller 发表于 2024-2-22 02:41

您好老师，您指点的这个我测试了一下，还有些疑惑，（中间单号有缺失的话，他会将后面的单号即使不缺失也一并标红了）调整不来，再次请您出手！谢谢！

李元聪

ykcbf1100 发表于 2024-2-22 07:51
参与一下。。。

您好老师，谢谢你们出手帮助，在同一张表里面已经能达到效果了，但实际上是sheet1和sheet2的关系！得再次麻烦您出手给看看，谢谢！

taller

李元聪 发表于 2024-2-22 11:53
您好老师，您指点的这个我测试了一下，还有些疑惑，（中间单号有缺失的话，他会将后面的单号即使不缺失也 ...

请修改一句

1. c.Characters(iLoc, Len(aNum(i))).Font.Color = vbRed

复制代码

ykcbf1100

李元聪 发表于 2024-2-22 12:00
您好老师，谢谢你们出手帮助，在同一张表里面已经能达到效果了，但实际上是sheet1和sheet2的关系！得再次 ...

附件更新一下。

ykcbf1100

代码更新。。。

1. Sub ykcbf()  '//2024.2.22
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     arr = Sheets("回收的表").UsedRange
   
4.     For i = 2 To UBound(arr)
   
5.         s = CStr(arr(i, 1))
   
6.         d(s) = ""
   
7.     Next
   
8.     With Sheets("我的表")
   
9.         .Cells.Font.ColorIndex = 0
   
10.         r = .Cells(Rows.Count, 1).End(3).Row
    
11.         arr = .Range("a1:a" & r)
    
12.         For i = 3 To UBound(arr)
    
13.             st = CStr(arr(i, 1))
    
14.             b = Split(st, ",")
    
15.             For x = 0 To UBound(b)
    
16.                 s = b(x)
    
17.                 If Not d.exists(s) Then
    
18.                     l = InStr(.Cells(i, 1), s)
    
19.                     With .Cells(i, 1).Characters(l, Len(s)).Font
    
20.                         .Color = RGB(255, 0, 0) ' 红色
    
21.                     End With
    
22.                 End If
    
23.             Next
    
24.         Next
    
25.     End With
    
26.     MsgBox "OK！"
    
27. End Sub
    

复制代码