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 .

 

TABLA ELIMINAR.xlsx

Editado el el 26 de febrero26 feb por Tilin2023

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

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

Perfecto, mañana lo intento

Prueba y comenta 

'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

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