-
Contador de contenido
2426 -
Unido
-
Última visita
-
Días con premio
231
Todo se publica por JSDJSD
-
'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
-
cambiar una ruta escrita manual a una variable
tema contestó a JSDJSD en MarianoCruz Macros y programación VBA
Sube tu archivo -
Registro con formulario varias veces.
tema contestó a JSDJSD en MarianoCruz Macros y programación VBA
Formulario Registro.xlsm -
Registro con formulario varias veces.
tema contestó a JSDJSD en MarianoCruz Macros y programación VBA
-
Registro con formulario varias veces.
tema contestó a JSDJSD en MarianoCruz Macros y programación VBA
Si nadie te contesta antes, mañana en cuanto tenga un ratillo te lo miro -
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
-
-
Si nadie contesta ante, mañana te lo miro
-
El archivo Propuesta25122024.xlsm
-
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
-
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.
-
Prueba y comenta Propuesta27102024.xlsm
-
Si está configurado así, como tendría que ser?
-
Por cierto en la columna D donde pone PDF no tienes que poner nada se hace automáticamente al escoger el pdf Propuesta27102024.xlsm