Macro para encontrar la ultima fecha de un item
----
---
Buena tarde
Pueden ayudarme con esto
Tengo una hoja en la que se van agregando las entradas de algunos articulos
El mismo articulo se repite varias veces pero con fecha diferente conforme van entrando
Lo que necesito es un codigo que me ayude a encontrar la ultima fecha en que cada articulo entro
La hoja donde ingresan los articulos tiene 8 columnas
1. Nombre del articulo
2. Fecha de entrada
3. Numero de referencia
4. Remitente o destinatario
5. Cantidad de entrada
6. Reajuste
7. Fecha de vencimiento
8. Lote
La idea es que busque en las fechas de entrada cuando entro por ultima vez cada articulo.
Si hay 50 articulos que busque cuando fue la ultima vez que entro cada uno de esos artilos.
Y el resultado lo pegue en la hoja "entradas recientes".
He buscado algun codigo similar pero no he encontrado algo que se ajuste a lo que necesito.
Espero me puedan ayudar
Gracias
----
---
--
2 Respuestas
Prueba esta macro, solo ajusta los worksheets y los range a tus necesidades, funciona además en cualquiera de las dos hojas
Sub fecha_reciente()
Set h1 = Worksheets("hoja1")
Set h2 = Worksheets("entradas recientes")
Set origen = h1.Range("a1").CurrentRegion
h2.Range("A1").CurrentRegion.Clear
With origen
f = .Rows.Count: c = .Columns.Count
.Resize(f, 2).Copy: h2.Range("a1").PasteSpecial
.nothing
End With
Set destino = h2.Range("A1").CurrentRegion
With destino
.Sort _
key1:=h2.Range(.Columns(1).Address), order1:=xlAscending, _
key2:=h2.Range(.Columns(2).Address), order2:=xlDescending, Header:=xlYes
.Rows(2).Resize(f - 1).RemoveDuplicates Columns:=1
.EntireColumn.AutoFit
.nothing
End With
End Sub
Gracias por la ayuda
Fíjate que me da error en los dos .nothing que aparecen en el código
Dice
Se ha producido el error '438' en tiempo de ejecución:
El objeto no admite esta propiedad o método
--
Y que me cope a partir de la fila 3 por favor
Solo borras los nothing son para liberar memoria y puedes poner una pantalla de tu información con un breve ejemplo, los datos no tienen que ser reales solo quiero ver la estructura para adaptar la macro
Esta es la lista
Columna 1 los nombres de los artículos
scolumna 2 las fechas de entradas
i podes hacer que al pegar los datos en la otra hoja pegue desde la fila 2 donde están los títulos
Y que luego ordene desde donde comienzan los datos, porque cuando ordena también toma la fila de los títulos.
---
---
Esta macro esta adaptada a tus datos este es el antes
y este el despues
y esta es la macro adaptada a tu informacion
Option Explicit
Sub copiar()
Dim datos As Range, destino As Range
Dim h1 As Worksheet, h2 As Worksheet
Dim filas As Integer
Set h1 = Worksheets("hoja1")
Set h2 = Worksheets("entradas recientes")
filas = h1.Range("a1").CurrentRegion.Rows.Count
Set datos = h1.Range("a2").Resize(filas - 1, 2)
h2.Cells.Clear
Set destino = h2.Range("a2").Resize(filas - 1, 2)
With datos
.Copy: destino.PasteSpecial xlPasteAllUsingSourceTheme
Set datos = Nothing
End With
With destino
.EntireColumn.AutoFit
.Sort _
key1:=h2.Range(.Columns(1).Address), order1:=xlAscending, _
key2:=h2.Range(.Columns(2).Address), order2:=xlDescending, Header:=xlYes
.RemoveDuplicates Columns:=1
Set destino = Nothing
End With
End Sub
Puedes obtener la fecha máxima utilizando una tabla dinámica.
Revisa el siguiente enlace para ver si te sirve la opción.
Generar tabla de dos columnas con los valores únicos otra tabla
Sal u dos