Saltar al contenido

JSDJSD

Exceler C
  • Unido

  • Última visita

Mensajes publicados por JSDJSD

  1. publicado

    Private Sub ComboBox1_Change()
        Dim hoja As Worksheet
        Dim fila As Long
        Dim ultimaFila As Long
        Dim columnas() As Variant
        Dim i, ii As Integer
        Dim codigo As String
        Dim encontrado As Boolean
    
        Set hoja = ThisWorkbook.Sheets("MATRIZ1")
        codigo = ComboBox1.Value
    
        ' Si ComboBox1 está vacío
        If ComboBox1.Value = "" Then
            UserForm_Initialize
            Exit Sub
        End If
    
        ' Si ComboBox1 tiene un valor (código)
        encontrado = False
        With ListBox1
            ' Limpiar ListBox
            .RowSource = ""
        
            ' Definir ColumnCount para el ListBox
            .ColumnCount = 6 ' 6 columnas (B, C, D, E, F, M)
            ' Columnas específicas: B, C, D, E, F, M (números de columna)
            columnas = Array(2, 3, 4, 5, 6, 13)
            .ColumnWidths = "70;90;90;90;90;90;0;0;0;0;0;0;0;0"
            .ColumnHeads = False
            ' Agregar la cabecera al ListBox (desde la fila 4, columnas B, C, D, E, F, M)
            .AddItem hoja.Cells(4, columnas(0)).Value ' Columna B
            For ii = 1 To UBound(columnas)
                .List(0, ii) = hoja.Cells(4, columnas(ii)).Value ' Añadir encabezados de las otras columnas
            Next ii
        
            ' Determinar última fila con datos en la columna B
            ultimaFila = hoja.Cells(hoja.Rows.Count, "B").End(xlUp).Row
        
            ' Recorrer desde la fila 5 hacia abajo
            For fila = 5 To ultimaFila
                If hoja.Cells(fila, 2).Value = codigo Then ' Columna B
                    encontrado = True
                    ' Añadir nueva fila al ListBox (empieza en la segunda fila del ListBox)
                    .AddItem hoja.Cells(fila, columnas(0)).Value ' Columna B
                    For i = 1 To UBound(columnas)
                        ' Asegurarse de que se estén agregando todos los valores correctamente
                        .List(Me.ListBox1.ListCount - 1, i) = hoja.Cells(fila, columnas(i)).Value ' Rellenar las otras columnas
                    Next i
                End If
            Next fila
        End With
        If Not encontrado Then
            MsgBox "No se encontró el código en la hoja.", vbInformation
        End If
    End Sub

     

  2. publicado

    '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

  3. publicado

    Cambia el código de tu botón Registrar por este modificado

    Private Sub CommandButton1_Click()
        ' Declaramos variables
        Dim DescripSelec As Variant
        Dim Codigos As Variant
        Dim strcodig2 As String
        Dim intCantidad As Double
        Dim doublePUnitario As Double
        Dim intTotal As Double
        Dim Codigo As Variant
        
        ' Capturamos el valor del ComboBox1
        Codigo = Me.ComboBox1.Value
        
        ' En caso de error
        On Error Resume Next
        
        ' Inicializamos búsqueda de código
        With Application.WorksheetFunction
            ' Buscar directamente sin conversión
            Codigos = .VLookup(Codigo, PRODUCTOS.Range("A:C"), 1, 0)
            
            ' Si no se encuentra, mostrar "No encontrado"
            If IsError(Codigos) Then
                Codigos = "No encontrado"
            End If
            
            ' Buscar descripción (mismo proceso que el código)
            DescripSelec = .VLookup(Codigo, PRODUCTOS.Range("A:C"), 2, 0)
            
            If IsError(DescripSelec) Then
                DescripSelec = "No encontrado"
            End If
            
            ' Captura cantidad
            intCantidad = Me.TextBox1.Value
            
            ' Llenamos el ListBox
            Me.ListBox1.AddItem Codigo
            ListBox1.List(ListBox1.ListCount - 1, 1) = DescripSelec
            ListBox1.List(ListBox1.ListCount - 1, 2) = .Text(intCantidad, "#,##0")
            
            ' Precio unitario
            doublePUnitario = Me.TextBox2.Value
            ListBox1.List(ListBox1.ListCount - 1, 3) = .Text(doublePUnitario, "$#,##0.00;-$#,##0.00")
            
            ' Total
            intTotal = doublePUnitario * intCantidad
            ListBox1.List(ListBox1.ListCount - 1, 4) = .Text(intTotal, "$#,##0.00;-$#,##0.00")
            
            ' Actualización de etiquetas
            Me.lblProductos = .Text(CInt(Me.lblProductos) + CInt(intCantidad), "#,##0")
            Me.lblTotal = .Text(CDbl(Me.lblTotal) + CDbl(intTotal), "$#,##0.00;-$#,##0.00")
            
            ' Restablecer valores
            Me.ComboBox1.Value = ""
            Me.ComboBox1.SetFocus
            
            Me.txtConsec = Me.TextBox4.Value
            Me.TextBox5.Value = Format(CDate(TextBox5.Text), "dd/mm/yyyy")
            Me.txtFecha = Me.TextBox5.Value
        End With
    End Sub