1

quisiera pedir su ayuda para lograr comparar 2 distintas hojas de Excel mediante una macro. Actualmente estoy usando un ciclo for para recorrer ambas columnas y hacer una comparación. Esta forma es efectiva, pero tarda demasiado. Tengo que analizar más de 3000 registros.

Sub btnValidar()

Dim UltCol As Integer
Dim ultimaFila, uultimaFila, igual As Long

ultimaFila = ThisWorkbook.Sheets("Base Original").Cells(Cells.Rows.Count, 1).End(xlUp).Row
uultimaFila = ThisWorkbook.Sheets("Externa").Cells(Cells.Rows.Count, 1).End(xlUp).Row

For i = 2 To ultimaFila
    cta_cte = ThisWorkbook.Sheets("Base Original").Range("A" & i).Value
        For x = 2 To uultimaFila
        ccta_cte = ThisWorkbook.Sheets("Externa").Range("A" & x).Value

        If ccta_cte = cta_cte Then
        igual = igual + 1
        Next
Next
MsgBox "Cantidad de cuentas iguales = " & igual
Application.ScreenUpdating = False
End Sub

Alguien podría ayudarme a lograr el mismo resultado pero de una manera mucho más eficiente? Gracias!

1
  • No te sirve un CONTAR.SI? pones la fórmula en el libro que quieras y cuentas cuántas veces aparece el registro en la otra hoja. no necesitas hacer bucles ni nada.
    – Damian
    Commented el 19 feb. 2020 a las 22:24

2 respuestas 2

1

Esto debería tardar unos segundos, si no es instantáneo:

Option Explicit
Sub btnValidar()

    'Dim UltCol As Integer 'Siempre Long, Excel trunca los long cuando declaras un integer
    'Dim ultimaFila, uultimaFila, igual As Long 'estás declarando igual como long, las otras como variant

    'Creamos dos arrays, uno con los datos de la hoja Base Original, y el otro con los de la Externa
    'Sólo cogemos la columna A ya que ahí están los datos a comprobar.
    Dim arrOriginal As Variant: arrOriginal = CargaArray(ThisWorkbook.Sheets("Base Original"))
    Dim arrExterna As Variant: arrExterna = CargaArray(ThisWorkbook.Sheets("Externa"))
    Dim CuentasOriginales As Object: Set CuentasOriginales = CargaCuentasOriginales(arrOriginal)
    Dim i As Long
    Dim igual As Long
    'recorremos el array de las externas comprobando si existen en la original
    'si una cuenta está 3 veces, la contará 3 veces.
    For i = 2 To UBound(arrExterna)
        If CuentasOriginales.Exists(arrExterna(i, 1)) Then igual = igual + 1
    Next i
    MsgBox "Cantidad de cuentas iguales = " & igual
    Erase arrOriginal
    Erase arrExterna
    Set CuentasOriginales = Nothing

End Sub
Private Function CargaArray(ws As Worksheet) As Variant

    'Esta funcion va a devolver un array 2D de la columna A
    'Depende de la hoja que le des como parámetro
    With ws
        Dim ultimaFila As Long: ultimaFila = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
        Dim arr As Variant: arr = .Range("A1:A" & ultimaFila).Value2
    End With
    CargaArray = arr

End Function
Private Function CargaCuentasOriginales(arr As Variant) As Object

    'Esta función te va a devolver un objeto de clase Diccionario,
    'los objetos de diccionario tienen la propiedad .Exists que te permite
    'saber si existe una llave dentro del mismo de forma rápida.
    Dim Dict As Object: Set Dict = CreateObject("Scripting.Dictionary")
    Dim i As Long
    For i = 2 To UBound(arr) 'empiezo por 2 porque entiendo que en la 1 tienes encabezados
        'Para evitar errores ignoro las cuentas duplicadas en la hoja Originales.
        If Not Dict.Exists(arr(i, 1)) Then Dict.Add arr(i, 1), 1
    Next i
    Set CargaCuentasOriginales = Dict
    Set Dict = Nothing

End Function
4
  • Hola Damian, muchas gracias! Sin embargo cuando lo intento ejecutar, dice "la variable de objeto o bloque with no establecido" y me arroja el error en esta línea,: "If CuentasOriginales.Exists(arrExterna(i, 1)) Then", importé la librería Microsoft Scripting Runtime. Me podrías ayudar ? se ve bastante interesante esta manera de hacerlo Commented el 21 feb. 2020 a las 0:35
  • disculpa @IgnacioGabriel, a veces se me olvida devolver el valor a la función, me faltaba un Set CargaCuentasOriginales = Dict en esa función.
    – Damian
    Commented el 21 feb. 2020 a las 7:03
  • Ya estaba la línea, le quité la asignación de Nothing a Dict y lo puse con un If. Ahora funciona bien ! Muchas gracias! Commented el 21 feb. 2020 a las 15:14
  • Si te ha resultado útil, por favor considera en marcar la respuesta como válida
    – Damian
    Commented el 21 feb. 2020 a las 16:13
1

No sé cuanto tiempo tarda tu código, pero yo he hecho una prueba con CONTAR.SI

He creado un archivo Excel con 2 hojas.

  1. En la hoja BASE ORIGINAL he generado en la columna A un total de 50.000 números aleatorios
  2. Lo mismo en la hoja EXTERNA
  3. El código inserta en la columna B de la hoja BASE ORIGINAL un CONTAR.SI, que cuenta cuántas veces aparece cada número en la columna A de la hoja EXTERNA.
  4. Luego suma el resultado, y lo devuelve en la ventana Inmediato, y borra los datos de la columna B.

Tarda 20 segundos en contar las 50.000 celdas.

Sub test_con_formula()
Application.ScreenUpdating = False
Dim Inicio As Date
Inicio = Now

Dim UltimaFilaOrigen As Long
Dim UltimaFilaDatos As Long

With ThisWorkbook.Worksheets("Base Original")
    UltimaFilaOrigen = .Range("A" & .Rows.Count).End(xlUp).Row
End With

With ThisWorkbook.Worksheets("Externa")
    UltimaFilaDatos = .Range("A" & .Rows.Count).End(xlUp).Row
End With

ThisWorkbook.Worksheets("Base original").Range("B1:B" & UltimaFilaOrigen).FormulaR1C1 = _
        "=COUNTIF(Externa!R1C1:R" & UltimaFilaDatos & "C1,'Base Original'!RC[-1])"
DoEvents

Debug.Print "total coincidencias: " & Application.WorksheetFunction.Sum(ThisWorkbook.Worksheets("Base original").Range("B1:B" & UltimaFilaOrigen)), "total tiempo: " & Format(Now - Inicio, "hh:nn:ss")

ThisWorkbook.Worksheets("Base original").Range("B1:B" & UltimaFilaOrigen).Clear

Application.ScreenUpdating = True

End Sub

Y me devuelve esto:

introducir la descripción de la imagen aquí

Espero que puedas adaptar el código a tus necesidades.

Un saludo.

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.