Question

我不能为我的生活弄清楚为什么我的字典总是返回假。

注意：

我调试。在lookup.Add打印BuildVelocityLookup，它在整个范围内读取。
I Debug.Printed conUD，它也保持正确的值。
conUD值存在于第10列速度中。
值为字符串，字母数字，没有特殊字符。
值是唯一的，Scripting.Dictionary中没有重复的值。

非常感谢任何/所有帮助。

模块顶部：

Dim velocityLookup As Scripting.Dictionary
Const Velocity_Key_Col As Long = 10
Option Explicit

建立字典代码：

Sub BuildVelocityLookup(target As Worksheet, keyCol As Long, lookup As Scripting.Dictionary)
    Set lookup = New Scripting.Dictionary
    With target
        Dim lastRow As Long
        lastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
        Dim keys As Variant
        keys = .Range(.Cells(2, keyCol), .Cells(lastRow, keyCol)).Value
        Dim j As Long
        For j = LBound(keys) To UBound(keys)
            'Note that the row is offset from the array.
            lookup.Add keys(j, 1), j + 1
        Next
    End With
End Sub

主要代码：请参阅'xxxxxxxxxx专线，了解字典上的第一个电话。

Sub Calculate_Click()

'******************* Insert a line to freeze screen here.

    Dim wsMain As Worksheet
    Dim wsQuantity As Worksheet
    Dim wsVelocity As Worksheet
    Dim wsParameters As Worksheet
    Dim wsData As Worksheet
    Dim lrMain As Long 'lr = last row
    Dim lrQuantity As Long
    Dim lrVelocity As Long
    Dim lrParameters As Long
    Dim lrData As Long
    Dim i As Long 'Row Counter

    'For Optimization Testing Only.
    Dim MainTimer As Double
    MainTimer = Timer

    Set wsMain = Worksheets("Main Tab")
    Set wsQuantity = Worksheets("Quantity Available")
    Set wsVelocity = Worksheets("Velocity")
    Set wsParameters = Worksheets("Parameters")
    Set wsData = Worksheets("Data Input by Account")

    lrMain = wsMain.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
    lrQuantity = wsQuantity.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
    lrVelocity = wsVelocity.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
    lrParameters = wsParameters.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
    lrData = wsData.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row

    Dim calcWeek As Long
    calcWeek = wsParameters.Range("B3").Value

    For i = 2 To 5 'lrQuantity
        With wsQuantity
            .Cells(i, 5) = .Cells(i, 1) & .Cells(i, 2)
            .Cells(i, 6) = .Cells(i, 1) & UCase(.Cells(i, 2).Value) & .Cells(i, 3)
        End With
    Next i

    wsData.Range(wsData.Cells(2, 1), wsData.Cells(lrData, 4)).Sort _
    key1:=wsData.Range("A2"), order1:=xlAscending, Header:=xlNo

    Dim tempLookup As Variant
    For i = 2 To 5 'lrData
        tempLookup = Application.VLookup(wsData.Cells(i, 2), wsParameters.Range("Table5"), 2, False)
        If IsError(tempLookup) Then
            wsData.Cells(i, 3).Value = "Missing"
        Else
            wsData.Cells(i, 3).Value = tempLookup
        End If
    Next i

    For i = 2 To 5 'lrVelocity
        With wsVelocity
            .Cells(i, 10) = .Cells(i, 1) & .Cells(i, 4) & .Cells(i, 5) & .Cells(i, 9)
            .Cells(i, 10).Value = CStr(Trim(.Cells(i, 10).Value))
            .Cells(i, 11) = .Cells(i, 6)
            .Cells(i, 12) = .Cells(i, 7)
            .Cells(i, 13) = .Cells(i, 8)
            .Cells(i, 14) = .Cells(i, 3)
            .Cells(i, 22) = .Cells(i, 1) & .Cells(i, 9)
        End With
    Next i

    wsVelocity.Range(wsVelocity.Cells(2, 1), wsVelocity.Cells(lrVelocity, 10)).Sort _
    key1:=wsVelocity.Range("J2"), order1:=xlAscending, Header:=xlNo

    BuildVelocityLookup wsVelocity, Velocity_Key_Col, velocityLookup

    Dim indexVelocity1 As Range
    Dim indexVelocity2 As Range
    Dim matchVelocity1 As Range
    Dim matchVelocity2 As Range

    With wsVelocity
        Set indexVelocity1 = .Range(.Cells(2, 7), .Cells(lrVelocity, 7))
        Set indexVelocity2 = .Range(.Cells(2, 3), .Cells(lrVelocity, 3))
        Set matchVelocity1 = .Range(.Cells(2, 1), .Cells(lrVelocity, 1))
        Set matchVelocity2 = .Range(.Cells(2, 22), .Cells(lrVelocity, 22))
    End With

    Dim indexQuantity As Range
    Dim matchQuantity As Range
    With wsQuantity
        Set indexQuantity = .Range(.Cells(2, 4), .Cells(lrQuantity, 4))
        Set matchQuantity = .Range(.Cells(2, 6), .Cells(lrQuantity, 6))
    End With

    Dim ShipMin As Long
    ShipMin = wsParameters.Cells(7, 2).Value

    wsMain.Activate
    With wsMain
        .Range(.Cells(2, 9), .Cells(lrMain, 20)).ClearContents
        .Range(.Cells(2, 22), .Cells(lrMain, 47)).ClearContents
    End With

    For i = 2 To lrMain
        With wsMain
            Dim conUD As String 'con=concatenate
            conUD = .Cells(i, 21) & .Cells(i, 4) & calcWeek
            Debug.Print conUD

            .Cells(i, 21) = .Cells(i, 5) & .Cells(i, 3)

            If .Cells(i, 8) <> 0 Then
                .Cells(i, 9) = .Cells(i, 6) / .Cells(i, 8)
            End If
 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
            Dim velocityRow As Long
            If velocityLookup.Exists(conUD) Then
                velocityRow = velocityLookup.Item(conUD)
                tempLookup = wsVelocity.Cells(velocityRow, 11)
            End If
            .Cells(i, 10).Value = tempLookup

            tempLookup = wsVelocity.Cells(velocityRow, 14)
            .Cells(i, 11).Value = tempLookup

            If .Cells(i, 9) > .Cells(i, 11) Then
                .Cells(i, 12).Value = Round((.Cells(i, 6) / .Cells(i, 11)) / .Cells(i, 10), 0.1)
            End If

            If .Cells(i, 6) > 0 Then
                If .Cells(i, 12) <> "" Then
                    .Cells(i, 13).Value = .Cells(i, 12) - .Cells(i, 8)
                End If
            End If

            Dim conECD As String
            conECD = .Cells(i, 5) & .Cells(i, 3) & .Cells(i, 4) & calcWeek
            If velocityLookup.Exists(conECD) Then
            velocityRow = velocityLookup.Item(conECD)
            tempLookup = wsVelocity.Cells(velocityRow, 12)
            End If

            If .Cells(i, 13) <> "" Then
                If tempLookup <> 0 Then
                    .Cells(i, 14).Value = Int(.Cells(i, 13) / tempLookup)
                End If
            End If

            If velocityLookup.Exists(conECD) Then
                velocityRow = velocityLookup.Item(conECD)
                tempLookup = wsVelocity.Cells(velocityRow, 13)
            End If
            If .Cells(i, 14) > tempLookup Then
                If .Cells(i, 14) <> "" Then
                    .Cells(i, 15).Value = tempLookup
                End If
            Else
                .Cells(i, 15).Value = .Cells(i, 14).Value
            End If

            If .Cells(i, 14) = "" Then
                If .Cells(i, 11) = "" Then
                    .Cells(i, 26) = ""
                Else
                    .Cells(i, 26).Value = Round(.Cells(i, 14).Value * .Cells(i, 11).Value, 0)
                End If
            End If

            tempLookup = Application.Index(indexQuantity, Application.Match((.Cells(i, 21).Value & "LIBERTY") _
                , matchQuantity, False))
            .Cells(i, 24).Value = tempLookup

            .Cells(i, 18).Value = .Cells(i, 24) - Application.SumIf(.Range(.Cells(1, 21), .Cells(i, 21)), _
                .Cells(i, 21).Value, .Range(.Cells(1, 26), .Cells(i, 26)))

            If velocityLookup.Exists(conUD) Then
                velocityRow = velocityLookup.Item(conUD)
                tempLookup = wsVelocity.Cells(velocityRow, 13)
            End If
            If .Cells(i, 26) > tempLookup Then
                .Cells(i, 28).Value = tempLookup
            Else
                .Cells(i, 28).Value = .Cells(i, 26).Value
            End If

            If .Cells(i, 18).Value < 0 Then
                .Cells(i, 29).Value = "C"
                .Cells(i, 27).Value = ""
            Else
                .Cells(i, 27) = .Cells(i, 28)
            End If

        .Cells(i, 31).Value = Application.SumIf(.Range(.Cells(2, 1), .Cells(lrMain, 1)), _
            .Cells(i, 1).Value, .Range(.Cells(2, 27), .Cells(lrMain, 27)))

            If .Cells(i, 5) = "" Then
                .Cells(i, 35) = ""
            Else
                .Cells(i, 35).Value = Application.Index(indexVelocity1, _
                Application.Match(.Cells(i, 5), matchVelocity1, False))
            End If

            If .Cells(i, 6).Value = 0 Then
                .Cells(i, 44).Value = 0
            Else
                .Cells(i, 44).Value = Round(((((.Cells(i, 6).Value / .Cells(i, 11).Value) _
                    / .Cells(i, 10).Value) - .Cells(i, 8).Value) / .Cells(i, 35).Value), 0.1)
            End If

            If .Cells(i, 6).Value = 0 Then
                .Cells(i, 34).Value = 0
                .Cells(i, 33) = 0
            Else
                .Cells(i, 34).Value = Round(((((.Cells(i, 6) / .Cells(i, 11)) / _
                .Cells(i, 10)) - .Cells(i, 8)) / .Cells(i, 35)) * .Cells(i, 11), 0.1)
                If .Cells(i, 34) > 0 Then
                    .Cells(i, 33) = .Cells(i, 34)
                Else
                    .Cells(i, 33) = 0
                End If
            End If

            .Cells(i, 37) = 1 + calcWeek
            .Cells(i, 38) = .Cells(i, 5) & .Cells(i, 37)
            .Cells(i, 39).Value = Application.Index(indexVelocity2, _
                Application.Match(.Cells(i, 38), matchVelocity2, False))
            .Cells(i, 40) = Round(((((.Cells(i, 6) / .Cells(i, 11)) * .Cells(i, 39)) _
                - .Cells(i, 6)) - (.Cells(i, 8) - .Cells(i, 6))) / .Cells(i, 35), 0.1)

            If .Cells(i, 40) < 0 Then
                .Cells(i, 41) = 0
            Else
                .Cells(i, 41) = .Cells(i, 40)
            End If

            .Cells(i, 42) = .Cells(i, 41) - .Cells(i, 33)

            If .Cells(i, 11) < .Cells(1, 44) Then
                .Cells(i, 45) = 0
                .Cells(i, 32) = .Cells(i, 45)
            Else
                .Cells(i, 32) = Application.Max(.Cells(i, 33), .Cells(i, 41))
                If .Cells(i, 44) < 0 Then
                    .Cells(i, 45) = ""
                Else
                    .Cells(i, 45) = .Cells(i, 44)
                End If
            End If

            If .Cells(i, 31) < ShipMin Then
                .Cells(i, 47) = 0
            Else
                .Cells(i, 47) = .Cells(i, 27)
            End If

            .Cells(i, 46) = .Cells(i, 1) & .Cells(i, 22) & .Cells(i, 47)


        End With

        If (i Mod 100) = 0 Then
            Debug.Print "Got to row "; i; " in "; Timer - MainTimer; " seconds."
        End If
    Next i

End Sub

Answer 1

从聊天中我们发现了大写错误。你可以通过强制一致的情况（使用LCASE或UCASE函数来避免这些（假设它们是错误的错误），个人偏好只是始终保持一致！）。

您还可以在实例化时使字典不区分大小写：

Set lookup = New Scripting.Dictionary
lookup.CompareMode = 1 'TextCompare

但是，在添加任何项目之前，您必须这样做。

{1}}事件触发。

BuildVelocityLookup

此外，由于Click的全部目的仅仅是实例化您的字典，您可以考虑将其更改为Sub BuildVelocityLookup(target As Worksheet, keyCol As Long, lookup As Scripting.Dictionary) If Not lookup Is Nothing Then Exit Sub '## Get out of here if the dict is already instantiated Set lookup = New Scripting.Dictionary With target Dim lastRow As Long lastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row Dim keys As Variant keys = .Range(.Cells(2, keyCol), .Cells(lastRow, keyCol)).Value Dim j As Long For j = LBound(keys) To UBound(keys) 'Note that the row is offset from the array. lookup.Add keys(j, 1), j + 1 Next End With End Sub，这将是更标准的用法。

通常： function 将值返回给对象/变量，而子例程执行某些操作，修改对象，环境等。传递对象{{1}允许BuildVelocityLookup表现得像Function，但除非你有特定的理由以这种方式设计它，否则函数可能更好：

ByRef

然后将其称为（如果您不介意每次用户点击时重写dict，请忽略Sub条件）：

Function

Answer 2

对于仍然停留在此错误上的其他任何人，我都遇到了类似的问题，但是原因是我在字典中添加了Range对象，而不是Range.Value属性。

例如

For Each part In Selection
    dict.Add part, part.Address
Next part

'this returns false
Debug.Print dict.Exists("some text in range")

但是如果我添加value属性，它将按预期工作：

For Each part In Selection
    Debug.Print part
    dict.Add part.Value, part.Address
Next part

'this returns true
Debug.Print dict.Exists("some text in range")

Dictionary.Exists始终为假

2 个答案: