COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

Tilin2023 · el miércoles a las 14:28

Buenos días con todo, espero se encuentren bien de salud!.

Favor quisiera ver si me pueden ayudar con lo siguiente.

Tengo una data en excel con los siguiente criterios FECHAS DIFERENTES , CODIGO Y NOMBRE DEL PRODUCTO.

Lo que quiero realizar es que si en la fecha 17-02 tienes cantidad x de códigos y si estos no se repite el día siguiente 18-02 que automáticamente se borre, esto con la finalidad de tener un control de a partir del 18 al 19 se repite 1 vez y no me considere 2 desde fecha 17-02 teniendo en cuenta que el producto en el 18-02 no aparece.

Lo sombreado son los que se repiten .

image.png.61d060ee2c0f3d1bc9a0cb3a94e600e2.png

TABLA ELIMINAR.xlsx

Editado el el miércoles a las 14:36 por Tilin2023

JSDJSD · hace 19 horas

En el ejemplo que pones como quedaría el resultado esperado?

Tilin2023 · hace 18 horas

hace 58 minutos , JSDJSD dijo:

En el ejemplo que pones como quedaría el resultado esperado?

Buenas tardes @JSDJSD espero te encuentres bien de salud,

este sería un ejemplo :

Como códigos que salieron el 17-02 en la fecha 18-02 ya no se repite automáticamente se borran los de la fecha 17 los códigos que no se repiten y los de fechas posteriores se mantiene y así sucesivamente.

TABLA ELIMINAR.xlsx

JSDJSD · hace 16 horas

Perfecto, mañana lo intento

JSDJSD · hace 4 horas

Prueba y comenta

JSDJSD · hace 4 horas

'Opción 1
Sub FiltrarSKUPorFecha(): Application.ScreenUpdating = False
    Dim ultimaFila As Long, fila As Long
    Dim diccionarioSKU As Object
    Dim listaEliminar As Object
    Dim fechaActual As String, fechaSiguiente As String
    Dim f As Variant
    
    With Sheets("Consolidado")
    
        ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        ' Crear diccionarios para comparar SKU y almacenar filas a eliminar
        Set diccionarioSKU = CreateObject("Scripting.Dictionary")
        Set listaEliminar = CreateObject("Scripting.Dictionary")
    
        ' Recorrer desde la primera fila hasta la penúltima
        For fila = 2 To ultimaFila - 1
            fechaActual = .Cells(fila, 1).Value
            fechaSiguiente = .Cells(fila + 1, 1).Value
            
            ' Solo comparar la fecha actual con la siguiente (inmediatamente superior)
            If fechaActual <> fechaSiguiente Then
                diccionarioSKU.RemoveAll ' Limpiar el diccionario antes de llenarlo
    
                ' Guardar los SKU de la fecha siguiente (solo de la siguiente)
                For f = fila + 1 To ultimaFila
                    If .Cells(f, 1).Value <> fechaSiguiente Then Exit For
                    diccionarioSKU(.Cells(f, 2).Value) = 1
                Next f
    
                ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse
                For f = fila To 2 Step -1
                    If .Cells(f, 1).Value <> fechaActual Then Exit For
                    ' Solo eliminar si el SKU no está en la fecha siguiente
                    If Not diccionarioSKU.exists(.Cells(f, 2).Value) Then
                        listaEliminar(f) = 1 ' Marcar fila para eliminar después
                    End If
                Next f
    
                ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha
                Exit For
            End If
        Next fila
    
        ' Eliminar las filas marcadas sin afectar el bucle principal
        For Each f In listaEliminar.keys
            .Rows(f).Delete
        Next
    End With
    MsgBox "Completado correctamente.", vbInformation
End Sub

'Opción 2
Sub FiltrarSKUPorFecha1(): Application.ScreenUpdating = False
    Dim ultimaFila As Long, fila As Long
    Dim listaEliminar As Collection
    Dim fechaActual As String, fechaSiguiente As String
    Dim f As Variant, i As Long
    Dim SKUExiste As Boolean
    
    With Sheets("Consolidado")
    
        ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        ' Inicializar la colección para marcar las filas a eliminar
        Set listaEliminar = New Collection
    
        ' Recorrer desde la primera fila hasta la penúltima
        For fila = 2 To ultimaFila - 1
            fechaActual = .Cells(fila, 1).Value
            fechaSiguiente = .Cells(fila + 1, 1).Value
            
            ' Solo comparar la fecha actual con la siguiente (inmediatamente superior)
            If fechaActual <> fechaSiguiente Then
                
                ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse
                For f = fila To 2 Step -1
                    If .Cells(f, 1).Value <> fechaActual Then Exit For
                    ' Comprobar si el SKU está en la fecha siguiente
                    SKUExiste = False
                    For i = fila + 1 To ultimaFila
                        If .Cells(i, 1).Value <> fechaSiguiente Then Exit For
                        If .Cells(i, 2).Value = .Cells(f, 2).Value Then
                            SKUExiste = True
                            Exit For
                        End If
                    Next i
                    ' Si el SKU no se encuentra en la fecha siguiente, marcar para eliminar
                    If Not SKUExiste Then
                        listaEliminar.Add f ' Marcar fila para eliminar después
                    End If
                Next f
                
                ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha
                Exit For
            End If
        Next fila
    
        ' Eliminar las filas marcadas sin afectar el bucle principal
        For Each f In listaEliminar
            .Rows(f).Delete
        Next f
    End With
    
    MsgBox "Completado correctamente.", vbInformation
End Sub

TABLA ELIMINAR.xlsm

Tilin2023 · hace 3 horas

Hace 1 hora, JSDJSD dijo:

'Opción 1
Sub FiltrarSKUPorFecha(): Application.ScreenUpdating = False
    Dim ultimaFila As Long, fila As Long
    Dim diccionarioSKU As Object
    Dim listaEliminar As Object
    Dim fechaActual As String, fechaSiguiente As String
    Dim f As Variant
    
    With Sheets("Consolidado")
    
        ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        ' Crear diccionarios para comparar SKU y almacenar filas a eliminar
        Set diccionarioSKU = CreateObject("Scripting.Dictionary")
        Set listaEliminar = CreateObject("Scripting.Dictionary")
    
        ' Recorrer desde la primera fila hasta la penúltima
        For fila = 2 To ultimaFila - 1
            fechaActual = .Cells(fila, 1).Value
            fechaSiguiente = .Cells(fila + 1, 1).Value
            
            ' Solo comparar la fecha actual con la siguiente (inmediatamente superior)
            If fechaActual <> fechaSiguiente Then
                diccionarioSKU.RemoveAll ' Limpiar el diccionario antes de llenarlo
    
                ' Guardar los SKU de la fecha siguiente (solo de la siguiente)
                For f = fila + 1 To ultimaFila
                    If .Cells(f, 1).Value <> fechaSiguiente Then Exit For
                    diccionarioSKU(.Cells(f, 2).Value) = 1
                Next f
    
                ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse
                For f = fila To 2 Step -1
                    If .Cells(f, 1).Value <> fechaActual Then Exit For
                    ' Solo eliminar si el SKU no está en la fecha siguiente
                    If Not diccionarioSKU.exists(.Cells(f, 2).Value) Then
                        listaEliminar(f) = 1 ' Marcar fila para eliminar después
                    End If
                Next f
    
                ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha
                Exit For
            End If
        Next fila
    
        ' Eliminar las filas marcadas sin afectar el bucle principal
        For Each f In listaEliminar.keys
            .Rows(f).Delete
        Next
    End With
    MsgBox "Completado correctamente.", vbInformation
End Sub

'Opción 2
Sub FiltrarSKUPorFecha1(): Application.ScreenUpdating = False
    Dim ultimaFila As Long, fila As Long
    Dim listaEliminar As Collection
    Dim fechaActual As String, fechaSiguiente As String
    Dim f As Variant, i As Long
    Dim SKUExiste As Boolean
    
    With Sheets("Consolidado")
    
        ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        ' Inicializar la colección para marcar las filas a eliminar
        Set listaEliminar = New Collection
    
        ' Recorrer desde la primera fila hasta la penúltima
        For fila = 2 To ultimaFila - 1
            fechaActual = .Cells(fila, 1).Value
            fechaSiguiente = .Cells(fila + 1, 1).Value
            
            ' Solo comparar la fecha actual con la siguiente (inmediatamente superior)
            If fechaActual <> fechaSiguiente Then
                
                ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse
                For f = fila To 2 Step -1
                    If .Cells(f, 1).Value <> fechaActual Then Exit For
                    ' Comprobar si el SKU está en la fecha siguiente
                    SKUExiste = False
                    For i = fila + 1 To ultimaFila
                        If .Cells(i, 1).Value <> fechaSiguiente Then Exit For
                        If .Cells(i, 2).Value = .Cells(f, 2).Value Then
                            SKUExiste = True
                            Exit For
                        End If
                    Next i
                    ' Si el SKU no se encuentra en la fecha siguiente, marcar para eliminar
                    If Not SKUExiste Then
                        listaEliminar.Add f ' Marcar fila para eliminar después
                    End If
                Next f
                
                ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha
                Exit For
            End If
        Next fila
    
        ' Eliminar las filas marcadas sin afectar el bucle principal
        For Each f In listaEliminar
            .Rows(f).Delete
        Next f
    End With
    
    MsgBox "Completado correctamente.", vbInformation
End Sub

TABLA ELIMINAR.xlsm 46.58 kB · 0 descargas

@JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS