Saltar al contenido

JSDJSD

Exceler C
  • Contador de contenido

    2426
  • Unido

  • Última visita

  • Días con premio

    231

Todo se publica por JSDJSD

  1. '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
  2. En el ejemplo que pones como quedaría el resultado esperado?
  3. Si puedes subir el libro mejor, en caso contrario la hoja afectada y la macro
  4. Si nadie te contesta antes, mañana en cuanto tenga un ratillo te lo miro
  5. 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
  6. Si nadie contesta ante, mañana te lo miro
  7. La posible solución te la he dado con el archivo anterior, no vi el nuevo que habías subido, pero bueno puedes adaptarlo perfectamente, no es difícil
  8. Esta parte no es difícil, inténtalo y si no lo consigues coméntalo Cemento.xlsm
  9. El archivo Propuesta25122024.xlsm
  10. Te entendí bien, pero me quede a medias, únicamente hacia lo que pedias cuando ponías directamente el NHC y no cuando lo buscabas con la lupa, prueba ahora y comenta
  11. Private Sub UserForm_Initialize() Dim hoja As Variant For Each hoja In Sheets If hoja.Name <> "Alta" And hoja.Name <> "Auxiliar" And hoja.Name <> "ddTraDa.hoja" Then ComboBox8.AddItem hoja.Name End If Next TextFechaReg = Format$(Date, "dd/mm/yyyy") End Sub Cambia en tu formulario Private Sub UserForm_Initialize() por este y solamente te cargara las hojas que necesitas actualmente, cuando añada nuevas que quieras incluirlas debes cambiar el código a tus necesidades.
  12. Tal cual veo tu archivo en el formulario MC-Agregar registros, en el comobox Nombre(nomHoja) solamente deberías cargar Berel y Romta, bueno míralo y comentas.
  13. Prueba y comenta Propuesta27102024.xlsm
  14. Private Sub ComboBox8_Change() Dim vhoja As String vhoja = ComboBox8.Text Me.txtCons = Application.WorksheetFunction.Max(Sheets(vhoja).Range("A:A")) + 1 End Sub registro consul.xlsm
  15. Si está configurado así, como tendría que ser?
  16. Por cierto en la columna D donde pone PDF no tienes que poner nada se hace automáticamente al escoger el pdf Propuesta27102024.xlsm
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.