Question

我正在尝试构建一个验证工具，它包含标头检查，欺骗检查和vLookup。在 DuplicateCheck 子例程中，我使用.Exists（）= False将范围中的所有唯一值添加到字典中;此检查是一致的失败，我正在添加重复值。似乎使用lower（）或upper（）修复了类似的问题，但我的测试是使用诸如“1”，“2”，“3”之类的数字，或者诸如“k1”，“k2”，“k2”之类的值”

这是我的代码：

Option Explicit

Dim wbThis As ThisWorkbook
Dim wsOld, wsNew, wsValid As Worksheet
Dim lColOld, lColNew, lRowOld, lRowNew, iRow, iCol As Long
Dim cellTarget, cellKey As Variant
Dim cellValid, dataOld, dataNew As Range

Sub Execute()

    Set wbThis = ThisWorkbook
    Set wsOld = wbThis.Worksheets(1)
    Set wsNew = wbThis.Worksheets(2)
    Set wsValid = wbThis.Worksheets(3)

    lColOld = wsOld.Cells(1, Columns.Count).End(xlToLeft).Column
    lColNew = wsNew.Cells(1, Columns.Count).End(xlToLeft).Column
    lRowOld = wsOld.Cells(Rows.Count, 1).End(xlUp).Row
    lRowNew = wsNew.Cells(Rows.Count, 1).End(xlUp).Row

    Set dataOld = wsOld.Range("A1").Resize(lRowOld, lColOld)
    Set dataNew = wsNew.Range("A1").Resize(lRowNew, lColNew)

    Call Validation.HeaderCheck
    Call Validation.DuplicateCheck
    Call Validation.vLookup

End Sub

Sub HeaderCheck()

    Application.StatusBar = "Checking headers..."

    Dim i As Long

    With wsNew
        For i = 1 To lColNew
            If (wsNew.Cells(1, i) <> wsOld.Cells(1, i)) Then
                MsgBox ("Column " & i & " on New Data is not the same as Old Data. This tool will not work with differences in headers. Please reorder your fields and run the tool again.")
                Application.StatusBar = False
                End
            End If
        Next i
    End With

    With wsOld
        For i = 1 To lColOld
            If (wsOld.Cells(1, i) <> wsNew.Cells(1, i)) Then
                MsgBox ("Column " & i & " on Old Data is not the same as New Data. This tool will not work with differences in headers. Please reorder your fields and run the tool again.")
                Application.StatusBar = False
                End
            End If
        Next i
    End With

    Application.StatusBar = False

End Sub

Sub DuplicateCheck()

    Dim iterator As Long
    Dim dicKeys As New Scripting.Dictionary
    Dim dicDupes As New Scripting.Dictionary
    Dim key As Variant
    Dim progPercent As Double
    Dim keys As Range
    Dim wsDupes As Worksheet

    Set keys = wsNew.Range("A2").Resize(lRowNew, 1)

    Application.ScreenUpdating = False

    iterator = 1
    For Each key In keys
        If dicKeys.Exists(key) = False Then
            dicKeys.Add key, iterator 'HERE IS THE BUG----------------------
        Else
            dicDupes.Add key, iterator
        End If
        progPercent = iterator / keys.Count
        Application.StatusBar = "Identifying duplicates: " & Format(progPercent, "0%")
        iterator = iterator + 1
    Next key


    If (dicDupes.Count <> 0) Then
        Set wsDupes = ThisWorkbook.Worksheets.Add(, wsValid, 1)
            wsDupes.Name = "Duplicates"
            iterator = 1
            For Each key In dicDupes
                    If (dicDupes(key) <> "") Then
                        wsDupes.Cells(iterator, 1).Value = dicDupes(key)
                    End If
                progPercent = iterator / dicDupes.Count
                Application.StatusBar = "Marking duplicates: " & Format(progPercent, "0%")
                iterator = iterator + 1
            Next key
    End If

    Set dicKeys = Nothing
    Set dicDupes = Nothing

    Application.ScreenUpdating = True

End Sub

Sub vLookup()

    Application.ScreenUpdating = False

    Dim progPercent As Double

    For iRow = 2 To lRowNew
        Set cellKey = wsNew.Cells(iRow, 1)

        For iCol = 1 To lColNew
            Set cellTarget = wsNew.Cells(iRow, iCol)
            Set cellValid = wsValid.Cells(iRow, iCol)

            On Error GoTo errhandler
            If (IsError(Application.vLookup(cellKey.Value, dataOld, iCol, False)) = False) Then
                If (cellTarget = Application.vLookup(cellKey.Value, dataOld, iCol, False)) Then
                    cellValid.Value = cellTarget
                Else
                    cellValid.Value = "ERROR"
                End If
            Else
                If (cellValid.Column = 1) Then
                    If (cellValid.Column = 1) Then
                        cellValid.Value = cellKey
                        cellValid.Interior.ColorIndex = 46
                    End If
                Else
                    cellValid.Value = "ERROR"
                End If
            End If

        Next iCol

        progPercent = (iRow - 1) / (lRowNew - 1)

        Application.StatusBar = "Progress: " & iRow - 1 & " of " & lRowNew - 1 & ": " & Format(progPercent, "0%")

    Next iRow

    Application.StatusBar = False

    Application.ScreenUpdating = True

Exit Sub
errhandler:
    MsgBox (Err.Description)
End Sub

Answer 1

问题可能在这里：

Dim key As Variant
Dim progPercent As Double
Dim keys As Range

然后当你在这里进行检查时：

For Each key In keys
    If dicKeys.Exists(key) = False Then
        dicKeys.Add key, iterator 'HERE IS THE BUG----------------------
    Else
        dicDupes.Add key, iterator
    End If
Next

它将key与Range进行比较，而不是value。尝试这样的事情：

If dicKeys.Exists(key.Value2) = False Then
    dicKeys.Add key.Value2, iterator

或者找到另一种不使用该对象的方法，但要找到它的值。

dictionary.Exists（key）总是假的

1 个答案: