[已解决]求一個 檢查重復項的宏

010203400

想要一個宏, 不要公式, 要求: 檢查A列中是否有相同的單元格, 有就提示.
請各位指導.

最佳答案

月排行榜 / 总排行榜

qh8600

2015-7-4 11:50

1. Sub demo()
   
2.     Dim d, ar, i, n
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     ar = Range("a1:a" & Cells(Rows.Count, 1).End(3).Row)
   
5.     For i = 1 To UBound(ar)
   
6.         If ar(i, 1) <> "" Then
   
7.             If Not d.Exists(ar(i, 1)) Then
   
8.                 d(ar(i, 1)) = ""
   
9.             Else
   
10.                 n = n + 1
    
11.             End If
    
12.         End If
    
13.     Next
    
14.     If n > 0 Then MsgBox "A列有重复"
    
15. End Sub

复制代码

这样

跳转到最佳答案楼层

qh8600

1. Sub demo()
   
2.     Dim d, ar, i, n
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     ar = Range("a1:a" & Cells(Rows.Count, 1).End(3).Row)
   
5.     For i = 1 To UBound(ar)
   
6.         If ar(i, 1) <> "" Then
   
7.             If Not d.Exists(ar(i, 1)) Then
   
8.                 d(ar(i, 1)) = ""
   
9.             Else
   
10.                 n = n + 1
    
11.             End If
    
12.         End If
    
13.     Next
    
14.     If n > 0 Then MsgBox "A列有重复"
    
15. End Sub

复制代码

这样

thinkersky

Public Sub 判断A列有无重复()
With CreateObject("ADODB.connection")
    .Open "Provider=Microsoft.ace.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=NO;';Data Source=" & ThisWorkbook.FullName
        不重复数 = .Execute("select count(*) from (select distinct f1 from  [" & ActiveSheet.Name & "$])")
        所有数量 = .Execute("select count(f1) from  [" & ActiveSheet.Name & "$]")
        If 不重复数.Item(0) < 所有数量.Item(0) Then MsgBox "A列有重复"
    .Close
End With
End Sub

010203400

qh8600 发表于 2015-7-4 11:50
这样

這個代碼對于現在的我有點難
我沒看懂, 但測試是可用的, 先留下, 慢慢研究.
感謝.

010203400

thinkersky 发表于 2015-7-4 13:42
Public Sub 判断A列有无重复()
With CreateObject("ADODB.connection")
    .Open "Provider=Microsoft.a ...

現在水平有限, 這個我就更看不懂了, 先留下, 慢慢研究.
感謝.