Excel - Consulta Macro para CalendarioExcel

 
Vista:
Imágen de perfil de Gerardo
Val: 28
Ha disminuido su posición en 3 puestos en Excel (en relación al último mes)
Gráfica de Excel

Consulta Macro para CalendarioExcel

Publicado por Gerardo (10 intervenciones) el 20/10/2019 18:40:53
Saludos,

Tengo una consulta referente a una Macro que he tratado de hacer, pero al parecer está mal creada.
(Adjunto Archivo)
Mismo en el cual aparecen 3 pestañas.
1) Glosario.
2) Bitácora, (Donde están registradas las acciones por hacer).
3) Calendario, (Donde se aprecia gráficamente las acciones de la Bitácora).

En resumen:
Necesito que las 2 letras de la "Columna C" (en Pestaña Bitácora), sean copiadas y pegadas (en Pestaña Calendario), según aplique para la Fecha [columna] y RoomCode [fila] correspondiente.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 3.828
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Consulta Macro para CalendarioExcel

Publicado por Antoni Masana (1295 intervenciones) el 21/10/2019 20:56:56
Te pongo la macro aquí para para explicarte algunos errores graves en la programación:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub ActualizarAcciones()
    '
    ' ActualizarAcciones Macro
    ' Actualiza Calendario Acciones
    '
    ' Acceso directo: CTRL+r
    '
    Application.ScreenUpdating = False
    Sheets("Calendario").Select
    CATEGORIAS = WorksheetFunction.CountA(Range("A3:A115"))
    Range("C3:ZZ115").ClearContents
    Sheets("Bitacora").Select
    ACCIONES = WorksheetFunction.CountA(Range("A:A"))
    For i = 2 To ACCIONES Step 1
 
SIGUIENTEACCION:
        Sheets("Bitacora").Select
        CATEGORIA = Range("B" & i).Value
        FECHA_DESDE = Range("D" & i).Value
        NOCHES = Range("F" & i).Value
 
        Sheets("Calendario").Select
 
        For x = 1 To CATEGORIAS Step 1
            Range("C" & x + 5).Select
            If ActiveCell.Value = FECHA_DESDE Then
                FILA = ActiveCell.Row
                Range("C1").Select
                For y = 1 To 999 Step 1
                    If ActiveCell.Value = FECHA_DESDE Then
                        COLUMNA = Split(ActiveCell.Address, "$")(1)
                        Range(COLUMNA & FILA).Activate
                        ActiveCell.Value = 1
                        For w = 1 To NOCHES Step 1
                            ActiveCell.Offset(0, 1).Activate
                            ActiveCell.Value = 1
                            If w = NOCHES Then
                                i = i + 1
                                GoTo SIGUIENTEACCION
                            End If
                        Next
                    End If
                ActiveCell.Offset(0, 1).Activate
                Next
            Else
                ActiveCell.Offset(0, 1).Activate
            End If
        Next
    Next
    Application.ScreenUpdating = True
    MsgBox "Acciones Procesadas"
    ActiveWorkbook.Save
End Sub

Empecemos por el más grave de todos: el GOTO de la línea 39 sobra porque además está mal, se tiene que hacer sin GOTO.

Seguimos, en la línea 5 vas recorriendo la columna C para buscar una fecha que esta en la fila 1.

Y ya a partir de aquí no he quiero mirar nada más porque me rechinan los dientes.

Esto quizás se ajuste mejor:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub ActualizarAcciones()
    Dim Acciones As Long, Fila As Long, Columna As Long, _
        F As Long, C As Long, CATEGORIA As String, _
        FECHA_DESDE As Date, NOCHES As Integer, i As Long
 
    Application.ScreenUpdating = False
    Sheets("Bitacora").Select
    Acciones = WorksheetFunction.CountA(Range("A:A"))
 
    For i = 2 To Acciones Step 1
 
        Sheets("Bitacora").Select
 
        CATEGORIA = Range("B" & i).Value
        FECHA_DESDE = Range("D" & i).Value
        NOCHES = Range("F" & i).Value
 
        Sheets("Calendario").Select
 
        ' ---&--- Busca la Columna
        Columna = 0
        C = 3
        While Cells(1, C) <> ""
            If Cells(1, C) = FECHA_DESDE Then Columna = C
            Col = Col + 1
        Wend
 
        ' ---&--- Busca la fila
        Fila = 0
        F = 4
        While Cells(F, 1) <> ""
            If Cells(F, 1) = CATEGORIA Then Fila = F
            Fil = Fil + 1
        Wend
 
        ' ---&--- Si tengo Fila y Columna Guardoo
 
        If Fila > 0 And Columna > 0 Then
           Cells(Fila, Columna) = NOCHES
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Acciones Procesadas"
'    ActiveWorkbook.Save
End Sub


Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Gerardo
Val: 28
Ha disminuido su posición en 3 puestos en Excel (en relación al último mes)
Gráfica de Excel

Consulta Macro para CalendarioExcel

Publicado por Gerardo (10 intervenciones) el 22/10/2019 00:36:44
Muchas Gracias Antoni,
Lamentablemente tu macro no pude ejecutarla. Podrías decirme si ésta adaptación la ejecutaría?
(Me parece que está configurada para que escriba "1", pero quisiera que pusiera las letras según corresponda)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub ActualizarAcciones()
 
    Application.ScreenUpdating = False 'Ocultamos Proceso
    Sheets("Calendario").Select 'Seleccionamos pestaña Calendario
    ROOMCODE = WorksheetFunction.CountA(Range("A3:A115")) 'Contamos cuantos Room Codes tenemos
    Range("C3:ZZ115").ClearContents 'Borramos contenido pasado
 
    Sheets("Bitacora").Select 'Seleccionamos pestaña Bitacora
    ACCIONES = WorksheetFunction.CountA(Range("A:A")) 'Contamos cuantas Acciones tenemos
 
    For i = 2 To ACCIONES Step 1
 
    'Inicia Bloque de Gestión
SIGUIENTEACCION:
    Sheets("Bitacora").Select
    ROOMCODE = Range("B" & i).Value 'Adquiere RoomCode
    FECHA_DESDE = Range("D" & i).Value 'Adquiere FechaDesde
    NOCHES = Range("F" & i).Value 'Adquiere NumNoches, menos día de salida
 
    Sheets("Calendario").Select
    For x = 1 To ROOMCODE Step 1 'Comenzamos el paso por las Acciones para rellenar
        Range("A" & x + 3).Select
        If ActiveCell.Value = ROOMCODE Then 'Cuando coincida la Accion con la que tenemos que cambiar
            Fila = ActiveCell.Row
            Range("C1").Select
            For y = 1 To 1000 Step 1 'Pasa por todos las fechas
        If ActiveCell.Value = FECHA_DESDE Then 'Si coincide las fechas empieza a rellenar
            Columna = Split(ActiveCell.Address, "$")(1)
            Range(Columna & Fila).Activate
            ActiveCell.Value = 1
            For w = 1 To NOCHES Step 1
                ActiveCell.Offset(0, 1).Activate
                ActiveCell.Value = 1
                If w = NOCHES Then
                    i = i + 1
                    SIGUIENTEACCION 'Vuelve a ejecutar proceso
                End If
            Next
        End If
    ActiveCell.Offset(0, 1).Activate
    Next
    Else
        ActiveCell.Offset(0, 1).Activate
    End If
Next
Next
Application.ScreenUpdating = True 'Mostramos proceso
MsgBox "ACCIONES PROCESADAS"
 
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar