AI机器人给了解决方法-多工作表单列数据有重复的标注单元格颜色

li446425169

1.检测表1和表2的A列（A2开始的所有有数据的单元格）数据是否在当前工作表A列中数据有重复

2.有重复的数据标注颜色底纹
3.最好有个弹窗提示哪个工作表有重复的数据，表1或者表2或者2个工作表都有重复的数据
哪位老师有空指教更简单的办法，谢谢

gwjkkkkk

请参考。。。

li446425169

gwjkkkkk 发表于 2023-4-3 19:09
请参考。。。

老师你好，谢谢帮助，我想要的是同时检测2个工作表，测试了代码只能同时检测一个工作表

gwjkkkkk

li446425169 发表于 2023-4-4 09:57
老师你好，谢谢帮助，我想要的是同时检测2个工作表，测试了代码只能同时检测一个工作表

请参考。。。

li446425169

1. Sub CheckDuplicateData()
   
2.     Dim ws As Worksheet
   
3.     Dim dict1 As Object, dict2 As Object
   
4.     Dim lastRow As Long, i As Long
   
5.     Dim cell As Range
   
6.     Dim duplicate As Boolean
   
7.     Dim duplicateFound1 As Boolean
   
8.     Dim duplicateFound2 As Boolean
   
9.    
   
10.     Set dict1 = CreateObject("Scripting.Dictionary")
    
11.     Set dict2 = CreateObject("Scripting.Dictionary")
    
12.    
    
13.     '恢复原来颜色
    
14.     For Each ws In ThisWorkbook.Worksheets
    
15.         If ws.Name = "表1" Or ws.Name = "表2" Then
    
16.             lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
17.             For i = 2 To lastRow
    
18.                 ws.Cells(i, 1).Interior.ColorIndex = xlNone
    
19.             Next i
    
20.         End If
    
21.     Next ws
    
22.    
    
23.     '检测表1中的重复数据
    
24.     For Each cell In Sheets("表1").Range("A2:A" & Sheets("表1").Range("A" & Rows.Count).End(xlUp).Row)
    
25.         If Not dict1.Exists(cell.value) Then
    
26.             dict1.Add cell.value, cell.Address
    
27.         Else
    
28.             duplicate = True
    
29.             Sheets("表1").Range(dict1(cell.value)).Interior.Color = vbYellow
    
30.             cell.Interior.Color = vbYellow
    
31.         End If
    
32.     Next cell
    
33.    
    
34.     '检测表2中的重复数据
    
35.     For Each cell In Sheets("表2").Range("A2:A" & Sheets("表2").Range("A" & Rows.Count).End(xlUp).Row)
    
36.         If Not dict2.Exists(cell.value) Then
    
37.             dict2.Add cell.value, cell.Address
    
38.         Else
    
39.             duplicate = True
    
40.             Sheets("表2").Range(dict2(cell.value)).Interior.Color = vbYellow
    
41.             cell.Interior.Color = vbYellow
    
42.         End If
    
43.     Next cell
    
44.    
    
45.     '提示重复数据
    
46.     For Each cell In Sheets("表1").Range("A2:A" & Sheets("表1").Range("A" & Rows.Count).End(xlUp).Row)
    
47.         If cell.Interior.Color = vbYellow Then
    
48.             duplicateFound1 = True
    
49.             Exit For
    
50.         End If
    
51.     Next cell
    
52.    
    
53.     For Each cell In Sheets("表2").Range("A2:A" & Sheets("表2").Range("A" & Rows.Count).End(xlUp).Row)
    
54.         If cell.Interior.Color = vbYellow Then
    
55.             duplicateFound2 = True
    
56.             Exit For
    
57.         End If
    
58.     Next cell
    
59.    
    
60.     If duplicateFound1 And duplicateFound2 Then
    
61.         MsgBox "表1和表2中都存在重复数据，请检查标记为黄色的单元格。"
    
62.     ElseIf duplicateFound1 Then
    
63.         MsgBox "表1中存在重复数据，请检查标记为黄色的单元格。"
    
64.     ElseIf duplicateFound2 Then
    
65.         MsgBox "表2中存在重复数据，请检查标记为黄色的单元格。"
    
66.     End If
    
67. End Sub

复制代码

以上是AI机器人写的代码，

li446425169

gwjkkkkk 发表于 2023-4-4 15:47
请参考。。。

谢谢帮助