Saltar al contenido

Ayuda en macro (soy nuevo)


Recommended Posts

publicado

Buenos días, soy nuevo en esta comunidad y quisiera pedirles su ayuda con la programación de este código, el cual estoy utilizando para crear números correlativos en las hojas de asistencia de mi trabajo, pero el cual me da un conflicto cuando quiero realizar las fechas correlativas. ¿Alguien me podría decir como solucionarlo?

La lógica del código se basa en los rangos de inicio y fiscalización para la impresión X26 y x27 son para los codigos y x28 y x29 son para las fechas que se presentaran en las impresiones

Sub ImprimirCorrelativos()

Dim lnI As Integer

Dim Resp As Integer

Dim Ini As Integer

Dim Fin As Integer

Dim i As Integer

Dim FIni As Date

Dim FFin As Date

Ini = Range("x26").Value

Fin = Range("x27").Value

FIni = Range("x28").Value

FFin = Range("x29").Value

[h23] = [x26]

[f23] = [x28]

lnI = MsgBox("¿Está Ud. seguro que imprime desde " & Str(Ini) & " hasta " & Str(Fin) & "?", vbYesNo, "Aviso")

If lnI = vbYes Then

Ini = Range("x26"): Fin = Range("x27")

For i = Ini To Fin

Range("h23") = i

Next i

If lnI = True Then

Else

Resp = MsgBox("¿Está Ud. seguro que imprime desde " & Str(FIni) & " hasta " & Str(FFin) & "?", vbYesNo, "Aviso")

If Resp = vbYes Then

FIni = Range("x28"): FFin = Range("x29")

For i = FIni To FFin 'En esta parte se me genera el error 6 de desbordamiento

Range("f23") = i

Selection.Cells.PrintPreview

Next i

End If

End If

End If

End Sub

publicado

Pero en el primer caso no me da ningún problema ya que son meramente números los códigos por ejemplo 002,003,004,... pero en cambio en el caso de las fechas e intentado colocarlas en formato general y aun así me parece el problema.

publicado

.

Revisa detenidamente las instrucciones de mi post anterior:

Recuerda subir un archivo de prueba la próxima vez.

.

publicado

.

La instrucción For Inicio To Fin/Next solo admite números enteros para las variables Inicio y Fin

Prueba cambiando:

FIni = Range("x28"): FFin = Range("x29")[/CODE]

por:

[CODE]FIni = CLng(Range("x28")): FFin = CLng(Range("x29"))[/CODE]

Recuerda que las variables [b][i]FIni [/i][/b]y [b][i]FFin [/i][/b]deben estar definidas como [b][i]Long[/i][/b].

.

publicado

Gracias por tú respuesta pero ante la necesidad logre por mis medios solventar el problema, te dejo aquí como me quedo el código al final. Por si a alguien le resulta útil. Pero me surgió otra duda...

¿Para darle formato a la variable Ini para que muestre únicamente el "dd" (formato de fecha) en el msgbox, que debo de modificar o cambiar?

Sub ImprimirCorrelativos()

Dim lnI As Long

Dim Ini As Date

Dim Fin As Date

Dim j As Long

Dim FIni As Date

Dim FFin As Date

Ini = Range("x33").Value

Fin = Range("x34").Value

FIni = Range("x35").Value

FFin = Range("x36").Value

[f23] = [x35]

[g23] = [x32]

[h23] = [f23]

lnI = MsgBox("¿Está Ud. seguro que imprime desde " & Str(Ini) & " hasta " & Str(Fin) & " y las fechas del" & Str(FIni) & " hasta " & Str(FFin) & "?", vbYesNo, "AVISO")

If lnI = vbYes Then

FIni = Range("x35"): FFin = Range("x36")

For j = FIni To FFin

Range("f23") = j

ActiveSheet.Range("A1:H46").PrintPreview

[h23] = [f23] + 1

Next j

End If

End Sub

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      29

    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • @JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS
    • '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
    • Hola a ambos, Comparto lo que dice el maestro Victor, no está clara la consulta en cuanto a las definiciones, si tuviera que deducir las piezas son el resultado de la multiplicación posterior a los gramos, como los ejemplos son botanas es posible que sean cajas por piezas. Si es el caso, una opción es convertir ese texto a una operación matemática después de extraerlo. Para esto se puede definir una función de EVALUAR que no siempre esta disponible pero se puede mandar llamar en la definición de los nombres. Por otro lado hay múltiples "p" que estorban un poco, (Principe ChocoBlanco EmpBco 12p 126g FLOW MLA) así que yo recomendaría definir nombres y segmentar las funciones, no es complicado aunque tal vez requiera un poco de experiencia del usuario si quiere editar en lo futuro. Tal vez con eso sería suficiente dando un resultado similar a lo siguiente:
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • 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.