Trabajar con Fechas

Buenos días por favor necesito que me aclaren que tengo malo en mi rutina, resulta que el modulo hace los siguiente: Solicito 5 datos: Obra, Semana, Desde, Hasta, Nº Maquina, los repito para los siete días de la semana introducida y luego en la columna 6 desgloso esos días es decir si la fecha introducida es Desde:25/02/09 Hasta: 03/03/09, es desglose seria: 25 - 26 - 27 - 28 - 1 - 2 - 3, pero la rutina me hace el desglose de la siguiente manera: 25 - 26 - 27 - 28 - 29 - 30 -31, no respeta el mes que es de 28 días y así pasa cuando el mes trae 30 días, cuando la semana cae justo en 31 si lo hace bien. Ayuda por favor... Mi modulo es la siguiente
 Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fila, fila2, var As Integer
fila = 9
fila2 = 9
While Cells(fila, 6) <> Empty
fila = fila + 1
Wend
Cells(fila, 1) = UCase(TextBox1)
Cells(fila, 2) = TextBox2
Cells(fila, 3) = CDate(TextBox3)
Cells(fila, 4) = CDate(TextBox4)
Cells(fila, 5) = TextBox5
TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
TextBox4 = Empty
TextBox5 = Empty
Worksheets("Control").Cells(fila, 6).Formula = "=Day(C" & fila & ")"
fecha = Worksheets("Control").Cells(fila, 3).Value
Mes = Month(fecha)
Rem AQUI SE REPITEN LOS DATOS
For counter = 1 To 6
    Worksheets("Control").Cells(fila + 1, 1).Value = Worksheets("Control").Cells(fila, 1).Value
    Worksheets("Control").Cells(fila + 1, 2).Value = Worksheets("Control").Cells(fila, 2).Value
    Worksheets("Control").Cells(fila + 1, 3).Value = Worksheets("Control").Cells(fila, 3).Value
    Worksheets("Control").Cells(fila + 1, 4).Value = Worksheets("Control").Cells(fila, 4).Value
    Worksheets("Control").Cells(fila + 1, 5).Value = Worksheets("Control").Cells(fila, 5).Value
    If Mes = "1" Or "3" Or "5" Or "7" Or "8" Or "10" Or "12" Then
        If Worksheets("Control").Cells(fila, 6).Value = 31 Then
                Worksheets("Control").Cells(fila + 2, 6).Value = var + 1
                var = var + 1
            Else
                Worksheets("Control").Cells(fila + 1, 6).Value = Worksheets("Control").Cells(fila, 6).Value + 1
        End If
    Else
    If Mes = "4" Or "6" Or "9" Or "11" Then
        var = 0
        If Worksheets("Control").Cells(fila, 6).Value = 30 Then
                Worksheets("Control").Cells(fila + 1, 6).Value = var + 1
                var = var + 1
            Else
                Worksheets("Control").Cells(fila + 1, 6).Value = Worksheets("Control").Cells(fila, 6).Value + 1
        End If
     Else
    If Mes = "2" Then
        If Worksheets("Control").Cells(fila, 6).Value = 28 Then
                Worksheets("Control").Cells(fila + 1, 6).Value = var + 1
                var = var + 1
            Else
                Worksheets("Control").Cells(fila + 1, 6).Value = Worksheets("Control").Cells(fila, 6).Value + 1
        End If
    End If
    End If
    End If
    fila = fila + 1
    fila2 = fila2 + 1
Next counter
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Unload Datos1
Consumo.Show
End Sub

1 Respuesta

Respuesta
1
Lo que tienes que hacer es declarar variables de tipo Date, para almacenar la fecha de inicio y la fecha de finalización. Luego usa un For para hacer tu rutina, mira esta macro de ejemplo:
Sub asdasd()
Dim asd As Date
Dim asd2 As Date
asd = "28/02/2009"
asd2 = "3/3/9"
For i = asd To asd2
    MsgBox i
Next
End Sub
Buenas tardes experto, realice el cambio pero funciona igual a como lo tengo, es decir, hace los mismo y lo que quiero es que no pase de largo al 28 en este caso porque el mes es febrero y debería quedar 25-26-27-28-1-2-3 y lo esta haciendo 25-26-27-28-29-30-1-2
¿Ejecutaste la macro de ejemplo que te puse?
Verás que del 28 de febrero pasa al 1 de marzo.
Si la ejecute pero no quiero que se muestren por mensaje si no colocarlos en la columna especifica y que sean los siete días de la semana dada. Si observas mi macro veras que evalúo si el mes y dependiendo entonces hago el dezgloze, pero cuando las fechas dadas son exacta como por ejemplo desde 24/06/09 al 30/06/09 lo desglosa bien, es decir, 24-25-26-27-28-29-30 pero cuando no son exacta es como si evaluara cuando la celda llega a 30 hace la rutina del 30. No encuentro que hacer tengo toda la semana en esto. Ayudame por favor. Gracias.
'REEMPLAZA LA MACRO QUE TIENES POR ESTA Y PRUEBA DE NUEVO
'YO YA HICE LA PRUEBA Y ME DA EL DIA CORRECTO
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fila, fila2, var As Integer
Dim DiadeInicio As Date
fila = 9
fila2 = 9
While Cells(fila, 6) <> Empty
fila = fila + 1
Wend
Cells(fila, 1) = UCase(TextBox1)
Cells(fila, 2) = TextBox2
Cells(fila, 3) = CDate(TextBox3)
Cells(fila, 4) = CDate(TextBox4)
DiadeInicio = Cells(fila, 3) 'LO MISMO QUE TEXTBOX3
Cells(fila, 5) = TextBox5
TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
TextBox4 = Empty
TextBox5 = Empty
Worksheets("Control").Cells(fila, 6).Formula = Day(DiadeInicio) '"=Day(C" & fila & ")"
'fecha = Worksheets("Control").Cells(fila, 3).Value
'Mes = Month(fecha)
Rem AQUI SE REPITEN LOS DATOS
For COUNTER = 1 To 6
    Worksheets("Control").Cells(fila + 1, 1).Value = Worksheets("Control").Cells(fila, 1).Value
    Worksheets("Control").Cells(fila + 1, 2).Value = Worksheets("Control").Cells(fila, 2).Value
    Worksheets("Control").Cells(fila + 1, 3).Value = Worksheets("Control").Cells(fila, 3).Value
    Worksheets("Control").Cells(fila + 1, 4).Value = Worksheets("Control").Cells(fila, 4).Value
    Worksheets("Control").Cells(fila + 1, 5).Value = Worksheets("Control").Cells(fila, 5).Value
    'ESTA ES LA QUE TE DA EL DÍA CORRECTO:
    Worksheets("Control").Cells(fila + 1, 6).Value = Day(DiadeInicio + COUNTER)
    fila = fila + 1
    'fila2 = fila2 + 1
Next COUNTER
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Unload Datos1
Consumo.Show
End Sub
Buenos Días experto, que maravilla es lo que quería, funciona muy bien, excelente, eres lo máximo, ya había consultado varios experto e incluso me dieron sus correos pero no me ayudaron, eres mi favorito. Mil Gracias, no dudare en seguir consultándote.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas