两个区域重复数据单元格加上红底

vilcent2014

区域1和区域2数据重复时，重复数据加底色
全网都没搜索到方法，需要使用vb来实现，但是本人菜鸟
望大师给出好的代码，谢谢！

vilcent2014

望大师们帮帮忙，谢谢

any1009

试试看：

1. Sub test()
   
2. 
   
3. arr = [A1].CurrentRegion
   
4. 
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. 
   
7. For i = 1 To UBound(arr)
   
8.     For j = 1 To UBound(arr, 2)
   
9.         If arr(i, j) <> "" Then
   
10.             d(arr(i, j)) = ""
    
11.         End If
    
12.     Next
    
13. Next
    
14. 
    
15. brr = [H1].CurrentRegion
    
16. 
    
17. For i = 1 To UBound(brr)
    
18.     For j = 8 To 7 + UBound(brr, 2)
    
19.         If d.exists(brr(i, j - 7)) Then
    
20.             Cells(i, j).Interior.ColorIndex = 3
    
21.         End If
    
22.     Next
    
23. Next
    
24. 
    
25. End Sub

复制代码

sj15627581616

1. Sub ts()
   
2. Dim rng As Range, arr(), brr()
   
3. For Each rng In Range("a1").CurrentRegion
   
4.     n = n + 1
   
5.     ReDim Preserve arr(1 To n)
   
6.     arr(n) = rng
   
7. Next
   
8. For Each rng In Range("h1").CurrentRegion
   
9.     m = m + 1
   
10.     ReDim Preserve brr(1 To m)
    
11.     brr(m) = rng
    
12. Next
    
13. For Each rng In Range("a1").CurrentRegion
    
14.     For i = 1 To UBound(brr)
    
15.         If brr(i) = rng.Value Then
    
16.              rng.Interior.Color = 255
    
17.         End If
    
18.     Next
    
19. Next
    
20. For Each rng In Range("h1").CurrentRegion
    
21.     For i = 1 To UBound(arr)
    
22.         If arr(i) = rng.Value Then
    
23.             rng.Interior.Color = 255
    
24.         End If
    
25.     Next
    
26. Next
    
27. End Sub
    

复制代码

参考

rhloo

101是否要红底？

笨鸟飞不高

有点看不懂你的要求！！ 区域1中的101，区域1中的第2个45为何不填颜色？？。。。

xuemei0216

看一下，是不是你想要的

vilcent2014

any1009 发表于 2020-6-29 13:22
试试看：

谢谢，太感谢了，我试试

vilcent2014

sj15627581616 发表于 2020-6-29 13:33
参考

这正是我想要的，谢谢！

vilcent2014

xuemei0216 发表于 2020-6-29 15:37
看一下，是不是你想要的

这个有点小问题，就是区域1没有，区域2的重复数据给标红了