用VBA For循环找到重名点数据巨慢

2013-01-05

用VBA For循环找出重名点数据巨慢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 临时表的所有记录。
[解决办法]

引用:

双重循环，耗时与行数是指数关系。

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

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

2 然后查询原表中行号 Not In 临时表的所有记录。

临时表的查询可以一句话就解决，
--查询第一个字段出现重复的ID，其它字段同理
select field1,count(field1) as 重复次数 from tableName
group by field1

having count(field1) >= 2

[解决办法]
用字典对象进行索引，费时的表格操作可以从 O(n^2) 简化到 O(n)。

'需要添加引用：Microsoft Scripting Runtime
Function 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 If

End Function

热点排行