0

Actualmente estoy usando un excel con Vba, donde utilizo 2 bucles para comparar datos de 2 hojas de excel distintas. Mi problema únicamente viene por el tiempo que tarda en procesar. Al usar varios For, lo que hago es buscar por cada elemento de la Hoja 1 en la Hoja 2 y así consecutivamente.

Estoy intentado adaptar el código usando como ejemplo el código el compañero @Damian sobre el uso de array para hacer esto mismo es mucho menos tiempo.

Este es el código que me gustaría usar , con el permiso del compañero Damian que lo puso en otra respuesta.

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

Mi problema es que no soy capaz de adaptarlo a mis necesidades.

Tengo 2 Hojas , en ambas tengo columnas coincidentes Hoja 1: Almacen ; Columna Albarán, columna CIF ,Columna Descripcion y columna precio ( 3.500 REgistros ). Hoja 2: Costes ; Columna Albarán, Columna CIF ,Columna Descripción y columna precio.

Tengo que buscar en la hoja costes, todas las coincidencias de la hoja Almacén donde coincidan todas las columnas.

El propósito de esto es el siguiente:

En la hoja costes tengo un albaran Nº.1 , este albarán puede estar en la Hoja almacen ( o no ). Si no está en la hoja almacén tendrá un asiento de Coste solamente -1.000€. Si está en la hoja almacén tendrá un asiento de coste y otro de abono ( todo esto en la hoja costes ) Coste -1.000€ y Abono 1.000€ ( entonces en la hoja almacén tendré ese albarán como 1.000€. Cuando ese albarán se saca del almacén a costes vuelve a tener otro asiento pero contrario.

Lo que necesito identificar es realmente de todos los movimientos que tengo en el almacén cuales siguen en el almacén y no se ha sacado a Costes.

Esto lo estoy haciendo como os digo con el siguiente código ( pero tarda una eternidad con For ).

Sub BuscarCostes()

    Dim ValorDocAlm As String
    Dim ValorDesAlm As String
    Dim ValorFechaAlm As Date
    Dim ValorImporte1Alm As Double
    Dim ValorImporte2Alm As Double
    '
    Dim ValorDocCostes As String
    Dim ValorDesCostes As String
    Dim Proveedor As String
    Dim Encontrado As Integer
    Dim Vuelta As Integer
    Encontrado = 0
    '
    Dim ColecAlb As New Collection
    '
    ufAlmacen = WsAlmacen.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    Set ConcatenaA = WsAlmacen.Range("A1:Z1").Find(What:="Nº documento", After:=ActiveCell, LookAt:=xlPart)
    ConcatenaA.Select
    ColumnaA = Split(ActiveCell.Address, "$")(1)
    Set ConcatenaB = WsAlmacen.Range("A1:Z1").Find(What:="Descripción", After:=ActiveCell, LookAt:=xlPart)
    ConcatenaB.Select
    ColumnaB = Split(ActiveCell.Address, "$")(1)
    Vuelta = 1
    WsCostes.Range("H1") = "Estado Albarán"
    For i = 2 To ufAlmacen
        ColecAlb.Add WsAlmacen.Range(ColumnaA & i).Value
        FormInicio.Ltxt.Caption = "Creando Colección " & ColecAlb(i)
        DoEvents
    Next i
    For m = 2 To ColecAlb.Count
        'restar = 0
        'ValorDocAlm = WsAlmacen.Range(ColumnaA & i).Value
        ValorDesAlm = WsAlmacen.Range(ColumnaB & m).Value
        ValorFechaAlm = WsAlmacen.Range("A" & m).Value
        ValorImporte1Alm = WsAlmacen.Range("T" & m).Value
        ValorImporte2Alm = WsAlmacen.Range("S" & m).Value
        Proveedor = WsAlmacen.Range("Z" & m).Value
        WsCostes.Select
        
            For e = 2 To Ufcostes
                Ufcostes = WsCostes.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
                Restar = 0
                DoEvents
                FormInicio.Ltxt = "Buscando.Alb: " & m & " de: " & ufAlmacen & " en Costes, Fila " & e & " de: " & Ufcostes
                ValorDocCostes = WsCostes.Range("F" & e).Value
                ValorDesCostes = WsCostes.Range("D" & e).Value
                '
                If ColecAlb(m) = ValorDocCostes And ValorDesAlm = ValorDesCostes Then 'And WsCostes.Range("H" & e).Value <> "ALB.CONSOLIDADO" Then
                    Encontrado = 1
                    WsCostes.Rows(e + 1).Insert Shift:=xlDown
                    'ufCostes = ufCostes + 1
                    WsCostes.Range("A" & e + 1) = ValorFechaAlm
                    'WsCostes.Range("A" & e + 1).Interior.Color = vbYellow
                    WsCostes.Range("B" & e + 1) = WsCostes.Range("B" & e).Value
                    'WsCostes.Range("B" & e + 1).Interior.Color = vbYellow
                    WsCostes.Range("C" & e + 1) = (ValorImporte1Alm + ValorImporte2Alm) * -1
                    WsCostes.Range("C" & e + 1).Interior.Color = vbRed
                    WsCostes.Range("C" & e + 1).Font.Color = vbWhite
                    WsCostes.Range("D" & e + 1) = ValorDesAlm
                    'WsCostes.Range("D" & e + 1).Interior.Color = vbYellow
                    WsCostes.Range("E" & e + 1) = Proveedor
                    'WsCostes.Range("E" & e + 1).Interior.Color = vbYellow
                    WsCostes.Range("F" & e + 1) = ValorDocAlm
                    WsCostes.Range("H" & e) = "EN ALMACEN"
                    WsCostes.Range("H" & e + 1) = "EN ALMACEN"
                    WsCostes.Range("F" & e + 1).Interior.Color = vbYellow
                    WsCostes.Range("F" & e).Interior.Color = vbYellow
                    'Encontrado = 0
                'Else
                 '   WsCostes.Range("H" & e) = "COSTE"
                End If
                'e = e + 1
                'WsCostes.Range("H" & e) = "COSTE EN ALMACEN"
               Next e
               If Encontrado = 0 Then 'And WsCostes.Range("G" & ufCostes + 1).Value <> "ALMACEN" Then
                    'ufCostes = WsCostes.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
                    'WsCostes.Rows(e + 1).Insert Shift:=xlDown
                    WsCostes.Range("A" & Ufcostes + 1) = ValorFechaAlm
                    'WsCostes.Range("A" & e + 1).Interior.Color = vbYellow
                    'WsCostes.Range("B" & e + 1) = WsCostes.Range("B" & e).Value
                    'WsCostes.Range("B" & e + 1).Interior.Color = vbYellow
                    WsCostes.Range("C" & Ufcostes + 1) = (ValorImporte1Alm + ValorImporte2Alm) * -1
                    WsCostes.Range("C" & Ufcostes + 1).Interior.Color = vbRed
                    WsCostes.Range("C" & Ufcostes + 1).Font.Color = vbWhite
                    WsCostes.Range("D" & Ufcostes + 1) = ValorDesAlm
                    'WsCostes.Range("D" & e + 1).Interior.Color = vbYellow
                    WsCostes.Range("E" & e + 1) = Proveedor
                    'WsCostes.Range("E" & e + 1).Interior.Color = vbYellow
                    WsCostes.Range("F" & Ufcostes + 1) = ValorDocAlm
                    WsCostes.Range("F" & Ufcostes + 1).Interior.Color = vbCyan
                    WsCostes.Range("H" & Ufcostes + 1) = "ALMACEN"
                    'WsCostes.Range("F" & e).Interior.Color = vbYellow
                    'ufCostes = ufCostes + 1
              End If
              Encontrado = 0
              Vuelta = 0
        Next m
End If

End Sub
5
  • Creo que sería más fácil si pudieras añadir un ejemplo de datos, aunque sean falsos. Ver de donde partes y a dónde quieres llegar ayudaría a entender mejor todo el proceso.Ten en cuenta que tu código es muy largo para estar leyéndolo, y quizás deberías poner solo la parte más relevante.
    – Esei
    el 10 nov. 2020 a las 12:05
  • Hola,voy a editar el post y pondré la parte del código que se encarga de hacer lo que comento. Y voy a ver como subir parte de los datos como bien dices. el 10 nov. 2020 a las 14:33
  • Ten en cuenta que recorrer la hoja con ese bucle e ir modificando las hojas por cada campo analizado requiere de mucho tiempo. Probablemente podrías hacer una operación parecida almacenando en arrays los datos de cada hoja y hacer las comprobaciones en memoria. Tampoco es lo más eficiente pero tardarías menos. Cuando la condición If se cumpla añades esos datos a un nuevo array, que mantendrás en memoria hasta el final. Entonces sólo tendrás volcarese array en la hoja WsCostes de una sola vez. Ya te digo, que no es lo más eficiente pero seguro que ahorras bastante tiempo.
    – dogwall
    el 12 nov. 2020 a las 5:27
  • Gracias, no he usado arrays , si colleciones. Podrías ponerme un pequeño ejemplo de 2 arrays comparandose y como se recuperarían los datos del tercero?. Sobre eso me pondré a trabajar para hacer lo que dices... es muy buena idea. el 12 nov. 2020 a las 7:41
  • Tienes un ejemplo de como crear arrays aqui: es.stackoverflow.com/questions/185749/… PAra compararlos simplemente sería algo en plan If MiArray1(1,1)= MiArray2 (1,1) Then...
    – Esei
    el 12 nov. 2020 a las 23:08

1 respuesta 1

0

De acuerdo a lo planteado, creo que no hay forma de hacerlo sin ciclos, esto es porque al final de cuentas se tienen que recorrer filas de datos, ya sea en un array, colección, o rango.

Me parece que el uso del ciclo For Each puede ser buena opción, de ese modo no seria necesario el ciclo que genera la colección.

Ejemplo:

Sub test()
    Dim rngAlbaran As Range
    Dim rngAlmacen As Range
    For Each rngAlbaran In wsCostes.Range("A2", wsCostes.Range("A2").End(xlDown))
        For Each rngAlmacen In wsAlmacen.Range("A2", wsAlmacen.Range("A2").End(xlDown))
            If rngAlmacen.Value = rngAlbaran.Value Then
                'Aquí se ponen las instrucciones a ejecutar si el dato del albarán en turno es igual al dato del almacén en turno.
            End If
        Next rngAlmacen
    Next rngAlbaran
End Sub

Lo que hace esto es recorrer las filas de la hoja "Costes", toma como base la columna A, por cada registro de esa hoja, se recorrerán todas las con datos de hoja "Almacén", esto tomando como base la columna A. Cada vez que encuentre un coincidencia, se ejecutara el código que esta dentro de los 2 ciclos.

En cada ciclo rngAlbaran y rngAlmacen hace referencia a la celda que en ese momento esta en su recorrido del rango, el valor de la celda se obtiene con el nombre de la variable rngAlbaran.Value y rngAlmacen.Value, también se puede hacer referencia a datos de otra columna en la misma fila, por ejemplo: rngAlbaran.Offset(0, 1) hace referencia a la celda que esta una columna a la derecha de la celda que se recorre al momento, esto significa que en cada ciclo tiene acceso a todos los datos de cada columna en la fila en turno.

Esto apenas es la estructura para recorrer los datos, creo que en el código que esta dentro de los ciclos también es muy probable que haya mucho por mejorar, pero para eso se requiere conocer los detalles de lo que se tiene que hacer.

1
  • Así es más rápido. muchas gracias. Lo acabo de implementar para esta comprobación y otras del mismo documento. el 16 nov. 2020 a las 6:30

Tu Respuesta

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

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