用VBA For循环找出重名点数据巨慢,该怎么处理

用VBA For循环找出重名点数据巨慢
VBA查找一个工作表里某列有重名的单元格、值。用for循环来实现，如果发现重名，背景设为红色。当要比较的数据比较大，如有10000个数据时，速度非常慢（无法忍受的慢）。不知道有没有办法加速。请大虾帮忙。代码如下：


Function checkDuplicate(ByVal wsName As String) As Boolean 'true ---has duplicate point
Dim ws As Worksheet
Dim ixRef, i, j, k As Integer

checkDuplicate = False


If ExistSheet(wsName) = True Then
  Set ws = ThisWorkbook.Worksheets(wsName)
  ws.Columns.ClearFormats
  ixRef = ws.Range("A65535").End(xlUp).Row 'calculate the total xref number
  For j = 3 To ixRef
  If ws.Cells(j, 1).Interior.ColorIndex = -4142 And (UCase(ws.Cells(j, 1)) = "A" Or UCase(ws.Cells(j, 1)) = "D") Then
  k = 0
  For i = j + 1 To ixRef
  If UCase(ws.Cells(i, 1)) = "A" Or UCase(ws.Cells(i, 1)) = "D" Then 
  If UCase(ws.Cells(j, 7)) = UCase(ws.Cells(i, 7)) Then
  checkDuplicate = True
  ws.Cells(i, 1).Interior.ColorIndex = 3
  k = k + 1
  End If
  End If
  Next
  If k > 0 Then
  ws.Cells(j, 1).Interior.ColorIndex = 3
  End If
  End If
  Next
  Set ws = Nothing
End If

End Function

[解决办法]
双重循环，耗时与行数是指数关系。

是否可以这样做：把 Excel 表当作 JetEngine 的外部数据库，

1 首先查询数据唯一记录，连同行号存入一个 Access 临时表。

2 然后查询原表中行号 Not In 临时表的所有记录。
[解决办法]

VB code

'需要添加引用：Microsoft Scripting RuntimeFunction checkDuplicate(ByVal wsName As String) As Boolean    Dim ws As Worksheet    Dim dic As Scripting.Dictionary    Dim ixRef As Long    Dim i As Long    Dim j As Long    Dim sValue As String        checkDuplicate = False    If ExistSheet(wsName) = True Then        Set ws = ThisWorkbook.Worksheets(wsName)        ws.Columns.ClearFormats        ixRef = ws.Range("A65535").End(xlUp).Row    'calculate the total xref number                Set dic = New Scripting.Dictionary '保存 {行号,值} 的字典        For j = 3 To ixRef            If (UCase(ws.Cells(j, 1)) = "A" Or UCase(ws.Cells(j, 1)) = "D") Then                sValue = UCase(ws.Cells(j, 7))                                If dic.Exists(sValue) Then                    '重复                    checkDuplicate = True                    '设置当前行红色                    ws.Cells(j, 1).Interior.ColorIndex = 3                    '设置首个重复行红色                    i = dic.Item(sValue)                    If i > 0 Then                        ws.Cells(i, 1).Interior.ColorIndex = 3                        '将行号变负数，下次不用再设红色了                        dic.Item(sValue) = -i                    End If                Else                    '不重复，则加入字典                    dic.Add sValue, j                End If            End If        Next                Set dic = Nothing        Set ws = Nothing    End IfEnd Function