No puedo entender por qué mi diccionario siempre devuelve falso.
Notas:
- Depurar. Imprimí el BuildVelocityLookup en la búsqueda. Agregue y está leyendo en todo el rango.
- Depurar Imprimé conUD y también tiene el valor adecuado.
- El valor conUD existe en la décima columna de velocidad.
- Los valores son cadenas, alfanuméricas sin caracteres especiales.
- Los valores son únicos, no hay valores duplicados en Scripting.Dictionary.
Any / All Help es muy apreciada.
Parte superior del módulo:
Dim velocityLookup As Scripting.Dictionary
Const Velocity_Key_Col As Long = 10
Option Explicit
Construir código de diccionario:
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
Código principal: Vea la línea 'xxxxxxxxxx para la primera llamada en el diccionario.
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
2 respuestas
Desde el chat identificamos un error de capitalización. Puede evitarlos (suponiendo que sean errores falsos) forzando un caso coherente (ya sea utilizando las funciones LCASE
o UCASE
, ¡una cuestión de preferencia personal es coherente en todo momento!).
También puede hacer que su diccionario no distinga entre mayúsculas y minúsculas en la instanciación:
Set lookup = New Scripting.Dictionary
lookup.CompareMode = 1 'TextCompare
Sin embargo, debe hacer esto antes de agregar cualquier elemento.
Una cosa que podría considerar también, no estoy seguro sobre el caso de uso aquí, es envolver su procedimiento BuildVelocityLookup
con algo de lógica para evitar reescribir el diccionario cada vez que {{X1} } evento de incendios.
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
Y también, dado que todo el propósito de BuildVelocityLookup
es simplemente crear una instancia de su diccionario, puede considerar cambiarlo a Function
, lo que sería un uso más estándar.
En general: función devuelve valores a objetos / variables, mientras que subrutinas realizan algunas acciones, modificando objetos, entorno, etc. Pasar objetos ByRef
permite un Sub
para comportarse como un Function
, pero a menos que tenga una razón específica para diseñarlo de esta manera, una Función probablemente sea mejor:
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
Y luego llámalo como (omite la condición If
si no te importa volver a escribir el dict cada vez que el usuario hace clic):
If velocityLookup Is Nothing Then
Set velocityLookup = BuildVelocityLookup(wsVelocity, Velocity_Key_Col)
End If
Para cualquier otra persona que todavía esté atrapada en este error, me había encontrado con un problema similar, pero la causa era que estaba agregando un objeto Range a mi diccionario en lugar de la propiedad Range.Value.
E.g.
For Each part In Selection
dict.Add part, part.Address
Next part
'this returns false
Debug.Print dict.Exists("some text in range")
Pero si agrego la propiedad value funciona como se esperaba:
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")
Nuevas preguntas
excel
Solo para preguntas sobre programación contra objetos o archivos de Excel, o desarrollo de fórmulas complejas. Puede combinar la etiqueta de Excel con VBA, VSTO, C #, VB.NET, PowerShell, automatización OLE y otras etiquetas y preguntas relacionadas con la programación, si corresponde. La ayuda general con respecto a MS Excel para funciones de hoja de trabajo única está disponible en Super User.