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

用VBA For循环找出重名点数据巨慢VBA查找一个工作表里某列有重名的单元格、值。用for循环来实现，如果发现重名，背景设为红色。当要比较的数据比较大，如有10000个数据时，速度非常慢（无法忍受的慢）。不知道有没有办法加速。请大虾帮忙。代码如下：Function checkDuplicate(ByVal wsName As String) As Boolean ‘true —has duplicate pointDim ws As WorksheetDim ixRef, i, j, k As IntegercheckDuplicate = FalseIf 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 = NothingEnd IfEnd Function——解决方案——————————————————–双重循环，耗时与行数是指数关系。是否可以这样做：把 Excel 表当作 JetEngine 的外部数据库，1 首先查询数据唯一记录，连同行号存入一个 Access 临时表。2 然后查询原表中行号 Not In 临时表的所有记录。——解决方案——————————————————–

探讨

双重循环，耗时与行数是指数关系。是否可以这样做：把 Excel 表当作 JetEngine 的外部数据库，1 首先查询数据唯一记录，连同行号存入一个 Access 临时表。2 然后查询原表中行号 Not In 临时表的所有记录。

——解决方案——————————————————–用字典对象进行索引，费时的表格操作可以从 O(n^2) 简化到 O(n)。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天下没有不散的宴席，也许这人间真的只有朦朦胧胧才是真。