VBA Diccionario alternativa a BUSCARV

[Luis Antonio Torres]

Estimados Amigos,

 

Buenas noches, una vez más requiriendo de su valiosa ayuda. Esta vez con el tema de saber más acerca de poder optimizar el BuscarV bajo vba, (VLOOKUP), ya que tengo un libro de unos 300000k registros y realmente ha tardado una eternidad en conseguir el objetivo aplicando formular1c1 y applicationvlookup. Consultando por ahí en google me encontré con el tema de los arrays y diccionarios, que increíblemente optimizan el trabajo de los vlookup en vba, pasando de hacer el trabajo de 30 minutos a 10 segundos sin exagerar. He intentando con un código que me ayudaron en un foro en inglés sin embargo no logro hacerlo trabajar además que soy nuevo en esto.

 

La idea es que la id de la hoja1, busque en la hoja2 y obtenga la columna x de la hoja 2 en función de la condición.

Este es el fichero para que alguien me de una manito por favor.

Gracias.

PRUEBAS2.xlsm

[ikanni]

Hola

Te dejo una opción con diccionario.

En la columna G de la hoja 1 elijes la columna, en una celda desplegable,  que quieras visualizar de la hoja 2.

Espero sea lo que buscabas

Saludos

Dictionary.rar

[Luis Antonio Torres]

Hace 9 horas, ikanni dijo:

Hola

Te dejo una opción con diccionario.

En la columna G de la hoja 1 elijes la columna, en una celda desplegable,  que quieras visualizar de la hoja 2.

Espero sea lo que buscabas

Saludos

Dictionary.rar 28 kB · 3 descargas

Hola, 

 

Muchas gracias por tu respuesta, he probado ejecutando la macro en el libro que tiene 300k registros y Excel se ha quedado congelado =(  y va 30 minutos. Alguna sugerencia?

 

 

 

[ikanni]

Hola Luis,

Pues la verdad no sé que puede ser.

300k filas, la verdad se me escapa, nunca he tratado con tantos registros con excel. Pero en teoría no debería ser ningún problema.

¡Has probado con 100 filas? ?Pasa lo mismo?. Acabo de probar con la excel que colgaste y funciona. Y no le debería costar mucho hacer las 300k filas.

 

[ikanni]

Ah! , tambien colocaria application.ScreenUpdating =False, con tantas filas ayudaria a excel.

[Abraham Valencia]

Creo que nuestro amigo debería compartir unos cuantos miles de sus datos para poder probar en ellos directamente. 

Abraham Valencia

[Luis Antonio Torres]

Hace 14 horas, ikanni dijo:

Hola Luis,

Pues la verdad no sé que puede ser.

300k filas, la verdad se me escapa, nunca he tratado con tantos registros con excel. Pero en teoría no debería ser ningún problema.

¡Has probado con 100 filas? ?Pasa lo mismo?. Acabo de probar con la excel que colgaste y funciona. Y no le debería costar mucho hacer las 300k filas.

 

@ikanni acabé de encontrar el error, pues estaba referenciando mal en el código del libro adjunto, increíblemente ha funcionado el diccionario, lo he utilizado como un buscarv, que demora 63,28 segundos en hacer lo que hacía con application.vlookup en 2 horas !!!! así me ha quedado el código: (el código lo encontré en un foro en inglés y me ha funcionado.

 

Option Explicit

Sub VBALookUpMejorado()
    Dim oDict As Object
    Dim lookupRange As Range
    Dim rangedestino As Range
    Dim iterator As Range
    Dim cel As Range
    Dim secs1 As Single
    Dim secs2 As Single

    'Dimension of the array should be the number of values you
    'want to store to correspond to the key.
    'In my example, 0 to 1 means there are two values,
    'a 0th value and a 1st value
    Dim arrayOfValues(0 To 2) As Variant


secs1 = Timer()
    'The range that we normally vlookup against (only
    'using the first column in my range)
                ''Establezco el rango en donde quiero buscar que quiero buscar para obtener datos de esa hoja
    Set lookupRange = Sheets("Hoja2").Range("A1:A241666") 'DATA TO BE COMPARED
                ''Configuro el diccionario
    Set oDict = CreateObject("Scripting.Dictionary")

    'Set optimization settings
    Application.ScreenUpdating = False


' DATA STORING EXTRACTED IN HOJA2
    For Each iterator In lookupRange
        'Check if the ID already exists
        If Not oDict.exists(iterator.Value) Then
            'create the array
            '0th element is the first column to right of iterator
            arrayOfValues(0) = iterator.Offset(, 1).Value

            '1st element is the second column to right of iterator
            arrayOfValues(1) = iterator.Offset(, 2).Value
            
            '2st element is the second column to right of iterator
            arrayOfValues(2) = iterator.Offset(, 3).Value

            'Add key and array to the dictionary
            oDict.Add iterator.Value, arrayOfValues
        End If
    Next iterator
    


Set rangedestino = Sheets("Hoja1").Range("A1:A300000") 'DATA TARGET

    For Each cel In rangedestino
    
    If oDict.exists(cel.Value) Then
    cel.Offset(, 6).Value = oDict(cel.Value)(1) 'Value extracted from dictionary in column "V" doesnot work =(
    

    End If
Next cel
secs2 = Timer()




MsgBox ("Time taken to run code:" & vbNewLine & secs2 - secs1 & " seconds")
    Application.ScreenUpdating = True
End Sub

Ahora sobre el (archivo que de antemano muchas gracias por la ayuda) soy un tanto nuevo en esto, tal vez sepas por qué se demora más que este código, si entiendo son lo mismo?

[Luis Antonio Torres]

Hace 5 horas, avalencia dijo:

Creo que nuestro amigo debería compartir unos cuantos miles de sus datos para poder probar en ellos directamente. 

Abraham Valencia

Hola @Abraham Valencia, El archivo lo subí con 100 registros, pensando pues en el límite del foro, sin embargo, he hecho pruebas hoy día y ha tardado 68 segundos en correr la macro sobre los 300k registros, soy nuevo en esto, pero habrá alguna manera de evitar tener que hacer esto, dado que podría tener 20 columnas en el diccionario y  no sé si podría ponerlo en un itinerador en vez de poner 20 líneas para cada valor?

 

Hace 2 minutos , Luis Antonio Torres dijo:

'0th element is the first column to right of iterator arrayOfValues(0) = iterator.Offset(, 1).Value '1st element is the second column to right of iterator arrayOfValues(1) = iterator.Offset(, 2).Value '2st element is the second column to right of iterator arrayOfValues(2) = iterator.Offset(, 3).Value