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
excel vba excel-vba
5
Emily Alden 22 mar. 2017 a las 18:52

2 respuestas

La mejor respuesta

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
3
David Zemens 22 mar. 2017 a las 16:35

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")
0
ismail 27 may. 2020 a las 07:55

Nuevas preguntas

2 Cómo copiar el encabezado de la columna de SQL Server a Excel
3 ¿Cómo resolver los subscritos fuera del error de rango en VBA?
2 Acelerar para cada bucle con variante de matriz. Excel VBA
2 Excel Dynamic Arrays - ¿Posible error?
3 Escribir matriz a la mesa
2 Autofundir cada n filas
2 En Excel, guarde una matriz por fila, utilizando un índice
3 Bucle a través de varios archivos en una carpeta A copiar y pegar desde una hoja de trabajo específica en un archivo maestro
2 Excel Cell en la lista en Python
4 No se puede imaginar por qué VBA sale de mi bucle para el próximo bucle cuando se verifica una declaración si
Nuevas preguntas con la etiqueta excel >

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.

Más sobre excel...