vba查询excel工作表内有没有重复的单元格，只能找出第一对重复的

likeyouli

Sub 查询工作表内单元格有没有重复值()
Dim d As New Dictionary, dizhi As Range, r As New RegExp, dizhi1 As Range
'两次使用正则表达式判定输入的格式是否正确
'Set r = CreateObject("VBScript.RegExp")
kaishi:
quyu = InputBox("请输入活动工作表的一个单元格（如a1，用currentregion）或输入一个区域（b2:c390）：", "请输入", "b2:c101")
Stop
r.Global = True
r.Pattern = "^[a-zA-Z]\d+$"
If r.Test(quyu) Then linshi = 3 Else linshi = 0
r.Pattern = "^[a-zA-Z]\d+:[a-zA-Z]\d+$"
If Not (r.Test(quyu)) And linshi = 0 Then MsgBox "输入格式错误，请重新输入": GoTo kaishi
If r.Test(quyu) Then
    Range(quyu).Select
    MsgBox "请查看选中的区域"
    arr = Range(quyu)
    For hang = LBound(arr) To UBound(arr)
        For lie = LBound(arr, 2) To UBound(arr, 2)
            If d.Exists(arr(hang, lie)) And arr(hang, lie) <> "" Then
            Set dizhi = Range(quyu).Find(arr(hang, lie))
            Set dizhi1 = Range(quyu).CurrentRegion.FindNext(dizhi)
              MsgBox "存在重复单元格，查询到的第一个重复单元格内容为""" & arr(hang, lie) & _
              """；地址为" & dizhi.Address(0, 0) & "和" & dizhi1.Address(0, 0): Union(dizhi, dizhi1).Select: Exit Sub
            Else
              d(arr(hang, lie)) = ""
             End If
        Next lie
    Next hang
'    Range(quyu).Interior.Pattern = xlPatternNone
Else
    Range(quyu).CurrentRegion.Select
    MsgBox "请查看选中的颜色区域"
   arr = Range(quyu).CurrentRegion
      For hang = LBound(arr) To UBound(arr)
        For lie = LBound(arr, 2) To UBound(arr, 2)
            If d.Exists(arr(hang, lie)) And arr(hang, lie) <> "" Then
            Set dizhi = Range(quyu).CurrentRegion.Find(arr(hang, lie))
            Set dizhi1 = Range(quyu).CurrentRegion.FindNext(dizhi)
              MsgBox "存在重复单元格，查询到的第一个重复单元格内容为""" & arr(hang, lie) & _
              """；地址为" & dizhi.Address(0, 0) & "和" & dizhi1.Address(0, 0): Union(dizhi, dizhi1).Select: Exit Sub
            Else
              d(arr(hang, lie)) = ""
             End If
        Next lie
    Next hang
   ' Range(quyu).CurrentRegion.Interior.Pattern = xlPatternNone
End If
MsgBox "恭喜，未发现重复单元格，代码结束！！"
End Sub

邪恶海盗

没看内容，我说一下逻辑：
1.分别返回有数据的最左最右列、最上最下行
2.循环挨个从左上单元格开始往下往右直到右下角单元格查找
3.将2获取到的值再与循环挨个从左上到右下角单元格比对
完毕...

1e3e

谢谢，vba高手啊

l3429900

ai可以编写，还可以修改

likeyouli

字典不会引用的
可以加上 set d = createobject("scripting.dictionary")   否则报错；
同理正则不会引用的，直接将Set r = CreateObject("VBScript.RegExp") 前边的 ' 去掉即可（即解除注释）

newswan

excel 能直接显示重复单元格

holley2008

我来帮着用AI改（其实最好有个现成的例子，这样出结果快）：

1. Sub 查找所有重复值()
   
2.     Dim d As Object, arr() As String
   
3.     Dim rng As Range, cell As Range
   
4.     Dim quyu As String, i As Long
   
5.     Dim hasDuplicates As Boolean
   
6.    
   
7.     '创建字典对象
   
8.     Set d = CreateObject("Scripting.Dictionary")
   
9.    
   
10.     '获取用户输入的区域
    
11.     On Error Resume Next
    
12.     Set rng = Application.InputBox( _
    
13.         "请选择要检查的区域：", _
    
14.         "选择区域", _
    
15.         Selection.Address, _
    
16.         Type:=8)
    
17.     On Error GoTo 0
    
18.    
    
19.     If rng Is Nothing Then Exit Sub  '用户取消
    
20.    
    
21.     '检查重复值
    
22.     For Each cell In rng
    
23.         If Len(Trim(cell.Value)) > 0 Then
    
24.             If d.Exists(cell.Value) Then
    
25.                 d(cell.Value) = d(cell.Value) & ", " & cell.Address(0, 0)
    
26.                 hasDuplicates = True
    
27.             Else
    
28.                 d(cell.Value) = cell.Address(0, 0)
    
29.             End If
    
30.         End If
    
31.     Next cell
    
32.    
    
33.     If hasDuplicates Then
    
34.         '显示所有重复值
    
35.         ReDim arr(1 To d.Count, 1 To 3)
    
36.         i = 0
    
37.         
    
38.         For Each cell In rng
    
39.             If Len(Trim(cell.Value)) > 0 Then
    
40.                 Dim addresses As String
    
41.                 addresses = d(cell.Value)
    
42.                
    
43.                 '如果地址中包含逗号，说明有重复
    
44.                 If InStr(addresses, ",") > 0 Then
    
45.                     i = i + 1
    
46.                     arr(i, 1) = cell.Value
    
47.                     arr(i, 2) = addresses
    
48.                     arr(i, 3) = Len(Split(addresses, ","))  '重复次数
    
49.                     
    
50.                     '高亮显示重复单元格
    
51.                     cell.Interior.Color = RGB(255, 255, 0)
    
52.                 End If
    
53.             End If
    
54.         Next cell
    
55.         
    
56.         '在工作表中显示结果
    
57.         Dim ws As Worksheet
    
58.         Set ws = Worksheets.Add
    
59.         ws.Name = "重复值报告"
    
60.         
    
61.         With ws
    
62.             .Range("A1:C1") = Array("重复内容", "所在位置", "重复次数")
    
63.             .Range("A2").Resize(i, 3) = arr
    
64.             .Columns.AutoFit
    
65.             .Rows(1).Font.Bold = True
    
66.         End With
    
67.         
    
68.         MsgBox "共发现 " & i & " 个重复值，已在新建的工作表中显示。"
    
69.     Else
    
70.         MsgBox "恭喜！未发现重复值。", vbInformation
    
71.     End If
    
72.    
    
73.     '清除高亮
    
74.     rng.Interior.ColorIndex = xlNone
    
75. End Sub

复制代码

a66

了解

likeyouli

newswan 发表于 2026-3-21 21:37
excel 能直接显示重复单元格

是的 ，条件格式里就能设置，，但vba更灵活，我想让代码怎么跑就怎么跑；
另外，查重复不是目的，这只是我代码一部分。我想用find查询，因为find只能查询到第一个待搜索内容，然后表格之间相加，然后自动更新表格数据....