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
If MiArray1(1,1)= MiArray2 (1,1) Then...