Dictionary.Exists始终为False
我不知道为什么我的字典总是返回错误。
笔记：
- 我Debug.Printed BuildVelocityLookup在lookup.Add，它正在读取整个范围。
- 我debugging。打印conUD，它也持有适当的价值。
- conud值存在于速度的第10列。
- 值是string，不带特殊字符的字母数字。
- 值是唯一的，Scripting.Dictionary中没有重复的值。
任何/所有的帮助，不胜感激。
模块顶部：
Dim velocityLookup As Scripting.Dictionary Const Velocity_Key_Col As Long = 10 Option Explicit build立字典代码：
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
从聊天我们确定了一个大写错误。 您可以通过强制一致的情况（使用LCASE或UCASE函数，个人偏好只是始终保持一致）来避免这些错误（假设它们是错误的错误）。
你也可以让你的字典在实例化时不区分大小写：
Set lookup = New Scripting.Dictionary lookup.CompareMode = 1 'TextCompare
不过，您必须在添加任何项目之前执行此操作。
有一件事你也可以考虑，不确定这里的用例是用一些逻辑来包装你的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
另外，由于BuildVelocityLookup的全部目的仅仅是实例化你的字典，所以你可以考虑把它BuildVelocityLookup一个Function ，这会更加标准。
通常情况下： 函数将值返回给对象/variables，而子例程执行某些操作，修改对象，环境等。传递对象ByRef允许Sub像Function ，除非您有具体的devise原因方法，一个函数可能会更好：
Function BuildVelocityLookup(target As Worksheet, keyCol As Long) As Scripting.Dictionary Dim lookup as 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 Set BuildVelocityLookup = lookup End Sub
然后调用它（如果你不介意每次用户点击时重写字典，则省略If条件）：
If velocityLookup Is Nothing Then Set velocityLookup = BuildVelocityLookup(wsVelocity, Velocity_Key_Col) End If