Comparar datos entre hojas de Excel mediante Macros
en estos momento estoy trabajando en una macro que me ayude a comparar datos, lo que debe hacer es que lea toda la Columna R, que tome el código que esta en la celda "R2" (C = Range"R2" [Por ejemplo] ), vaya a una hoja llamada "Ítem" y busque el código si no existe en la celda que esta 3 columnas a la izquierda"U2" (C = C.Offset (0, 3)) debe escribir "El código no existe", pero si existe a la celda U2 le debe enviar el valor que se encuentra en la hoja "Items" Columna M. Les dejare imágenes que ejemplifiquen lo que necesito
Primero debe pararse en el primer codigo de la Columna "R" de la hoja "RED ALDO", es decir "R2"
Luego debe buscar ese código en la columna "C" de la hoja "Items", si el código existe debe llevar el valor que esta en la misma fila pero de la columna "M"
Si no existe (como en este primer caso) debe colocar en la Columna "U" de la hoja "RED ALDO" el texto "El código no existe", así
Luego debe bajar a la siguente celda de la hoja "RED ALDO" osea "R3" y hacer el mismo proceso... (El código de esa celda tampoco existe, les dejare un ejemplo de cuando encuentra el código como es el caso de la celda "R4")
Encuentra el código, se mueve a la Columna "M" de la misma fila y copia el valor (ese valor es el resultado de una formula)
Luego regresa a la hoja "RED ALDO" y pega el valor (con pegado especial solo para valores)
También les doy este código con el que trate de hacer eso pero no me funciono
LastRow = Range("R" & Rows.Count).End(xlup).Row
For i = LastRow To 1
Cell = Range("R2")
A = Cell
B = Cell.Offset(0, 3)
Set h = Sheets("Items")
Set c = h.columns("C").Find(A, lookat:= xlWhole)
If Not c is Nothing Then
B=C
Else
B = "El código no existe"
Cell = Cell.Offset(1, 0)
End If
Next iCualquier información adicional o aclaraciones que necesiten con gusto se las dare
2 respuestas
Te anexo la macro
Sub Buscar_Dato()
'Por Dante Amor
Set h1 = Sheets("RED ALDO")
Set h2 = Sheets("Items")
'
For i = 2 To h1.Range("R" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("C").Find(h1.Cells(i, "R"), lookat:=xlWhole)
If Not b Is Nothing Then
h1.Cells(i, "U").Value = h2.Cells(b.Row, "M").Value
Else
h1.Cells(i, "U").Value = "El código no existe"
End If
Next
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
¡Gracias! de momento por ciertos cambios en el proyecto aún no puedo probar el código, pero en cuanto pueda te haré saber si funciona o si no, pero de seguro lo hará, muchas gracias
Hola Dante Amor, ya por fin pude probar tu código y me sale un mensaje diciendo: "Se ha producido el error '424' en tiempo de ejecución: Se requiere un objeto"
Y el error sale en la línea
If Not b Is Nothig Then
Yo le hice unas modificaciones al código (solamente en las columnas) y este es el nuevo
Private Sub cmdcomp_Click()
Set h1 = Sheets("RED ALDO")
Set h2 = Sheets("ITEMS")
For i = 2 To h1.Range("R" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("C").Find(h1.Cells(i, "R"), lookat:=xlWhole)
If Not b Is Nothig Then
h1.Cells(i, "V").Value = h2.Cells(b.Row, "I").Value
'Pegado especial
Else
h1.Cells(i, "U").Value = "Error"
End If
Next i
MsgBox "Listo."
End SubDonde esta el comentario de "Pegado especial" es porque el valor que se va a traer es resultado de un BuscarV, crees que al ser un valor especial se me este produciendo ese error?
En esta línea:
If Not b Is Nothig Then
Escribiste la palabra "Nothig" y debe ser "Nothing" , después de la "i" te faltó una "n"
¡Gracias! je je je, me siento como una tonta, muchas gracias
No te preocupes, a todos nos puede pasar, lo importante es intentarlo una y otra vez.
Se que no es apropiado que yo responda mi propia pregunta, pero el código que adjunte no era el que le quería dar, ya que ese estaba mal y olvide adjuntar el corregido, pero acá esta
Private Sub cmdcomp_Click()
lastRow = Range("R" & Rows.Count).End(xlDown).Row
For i = 1 To lastRow
Cell = Range("R2")
A = Cell
B = Range("Cell").Offset(0, 3)
Set h = Sheets("ITEMS")
Set c = h.Columns("C").Find(A, lookat:=xlWhole)
If Not c Is Nothing Then
B = c
Else
B = "El código no existe ena la hoja de Items"
Cell = A.Offset(1, 0)
End If
Next i
End SubMás sin embargo sigue sin funcionar