我一生都无法弄清楚为什么我的字典总是返回 false。
注释:
- 我在lookup.Add中调试并打印了BuildVelocityLookup，它正在整个范围内读取。
- 我 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
最佳答案
从聊天中我们发现了一个大写错误。您可以通过强制使用一致的情况来避免这些(假设它们是假错误)(使用 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 的全部目的只是实例化您的字典，因此您可能会考虑将其更改为 Function，这将是更标准的用法。
一般来说:函数将值返回给对象/变量，而子例程执行一些操作，修改对象、环境等。传递对象ByRef 允许 Sub 表现得像 Function，但除非您有这样设计的特定原因，否则 Function 可能会更好:
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
关于excel - Dictionary.Exists 始终为 False，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/42956707/