Dictionary.Exists Always False

Je ne peux pas pour la vie de ma découverte pourquoi mon dictionary revient toujours faux.

Remarques:

Je Débogue. Imprimé le BuildVelocityLookup à lookup.Add et il lit dans toute la gamme.
Je Débute.Imprimé le conUD et il détient également la valeur appropriée.
La valeur du conUD existe dans la 10ème colonne de vitesse.
Les valeurs sont des strings, alphanumériques sans caractères spéciaux.
Les valeurs sont uniques, il n'y a pas de valeurs en double dans Scripting.Dictionary.

Toute aide est très appréciée.

Haut de module:

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

Code du dictionary de construction:

 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

Code principal: voir 'xxxxxxxxxx Ligne pour le premier appel sur le dictionary.

 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 Ssortingng '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 Ssortingng 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

Du chat, nous avons identifié une erreur de capitalisation. Vous pouvez éviter cela (en supposant qu'ils soient fausses erreurs) en forçant un cas cohérent (soit en utilisant les fonctions LCASE ou UCASE , une question de preference personnelle tout simplement cohérente tout au long!).

Vous pouvez également rendre votre dictionary insensible à la casse lors de l'instanciation:

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

Vous devez le faire avant d'append d'autres éléments.

Une chose que vous pourriez également considérer, pas sûr du cas d'utilisation ici, est d'envelopper votre procédure BuildVelocityLookup avec une certaine logique pour éviter de BuildVelocityLookup le dictionary chaque fois que l'événement Click triggers.

 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

Et aussi, puisque l'objective entier de BuildVelocityLookup est de simplement créer un instancier sur votre dictionary, vous pourriez envisager de le modifier en Function , ce qui serait plus standard.

En général: les valeurs de return de la fonction aux objects / variables, alors que les sous-programmes exécutent des actions, modifient des objects, un environnement, etc. Passant des objects ByRef permet à un Sub de se comporter comme une Function , mais à less que vous ayez une raison spécifique de le concevoir Way, une fonction est probablement meilleure:

 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

Et puis appelez-le comme (omettre la condition If si vous ne vous inquiétez pas de réécrire le dictaque chaque fois que l'user clique):

 If velocityLookup Is Nothing Then Set velocityLookup = BuildVelocityLookup(wsVelocity, Velocity_Key_Col) End If