Realización macro excel comparativa precios.
Primero agradecerte tú atención a mi pregunta. Me dedico a montar tiendas virtuales no con muchos artículos así que las actualizaciones las hacia a mano. Estoy montando una de productos eróticos y me encuentro con el problema que tienen 8000 ref. Que se actualizan de 3 a 4 veces en el año, hacerlo a mano sería de locos. Te adjunto dos fotos de la tabla de productos en Excel. Necesito que la macro me compare mi tarifa con la que el proveedor me da el precio (si ha subido o bajado), artículos que han descatalogados, y que me localice los nuevos productos.
Si lo necesita te podría mandar la tarifa para que la puedas ver mejor.
Mil gracias.
1 Respuesta
Mejor envíame los 2 archivos y me explicas con colores un par de ejemplos.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Angeles Dominguez” y el título de esta pregunta.
Te anexo la macro para comparar.
Sub Comparar()
'Por.Dante Amor
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
'
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Clear
.Filters.Add "xls.*", "*.xls*"
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path & "\"
If .Show Then
Set l2 = Workbooks.Open(.SelectedItems.Item(1))
Set h2 = l2.ActiveSheet
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
Set b = h1.Columns("H").Find(h2.Cells(i, "A"), lookat:=xlWhole)
If Not b Is Nothing Then
If h1.Cells(b.Row, "P") <> h2.Cells(i, "J") Then
h1.Cells(b.Row, "AD") = h2.Cells(i, "J")
Else
h1.Cells(b.Row, "AD") = "igual"
End If
Else
u = h1.Range("H" & Rows.Count).End(xlUp).Row + 1
h1.Cells(u, "H") = h2.Cells(i, "A")
h1.Cells(u, "P") = h2.Cells(i, "J")
h1.Cells(u, "C") = h2.Cells(i, "B")
h1.Cells(u, "D") = h2.Cells(i, "C")
h1.Cells(u, "F") = h2.Cells(i, "D")
h1.Cells(u, "X") = h2.Cells(i, "N")
h1.Cells(u, "AD") = h2.Cells(i, "J")
End If
Next
End If
End With
l2.Close False
Columns("B:G").WrapText = False
MsgBox "Terminado", vbInformation, "COMPARAR"
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
