Como puedo resumir mi macro con lógicas

Mi macro se ejecuta como yo deseo pero veo muchas cosas que pueden ser abreviadas alguna idea de como realizarlo por favor adjunto foto de como queda mi macro que se trata de comentarios

Sub FECHA_INICIAL()
n = Sheets(1).Cells(4, "W")
a = (n - 1) * 40 + n + 6
Application.ScreenUpdating = False
Range("A" & a - 5 & ":" & "L" & a + 30).Select
Selection.ClearComments
Range("B" & a + 3).Select
For i = a To a + 27 Step 3
x = Int(Rnd * 10)
b = TimeValue(Cells(i + 1, 9))
hora = b + TimeValue("00:00:" & Format(x, "00"))
hora1 = b + TimeValue("00:00:" & Format(x + 3, "00"))
hora2 = b + TimeValue("00:00:" & Format(x + 6, "00"))
hora3 = b + TimeValue("00:00:" & Format(x + 9, "00"))
hora4 = b + TimeValue("00:00:" & Format(x + 12, "00"))
hora5 = b + TimeValue("00:00:" & Format(x + 15, "00"))
hora6 = b + TimeValue("00:00:" & Format(x + 18, "00"))
hora7 = b + TimeValue("00:00:" & Format(x + 21, "00"))
hora8 = b + TimeValue("00:00:" & Format(x + 24, "00"))
hora9 = b + TimeValue("00:00:" & Format(x + 27, "00"))
hora10 = b + TimeValue("00:00:" & Format(x + 30, "00"))
hora11 = b + TimeValue("00:00:" & Format(x + 33, "00"))
hora12 = b + TimeValue(Format(2, "00") & ":" & Format(2, "00") & ":" & Format(x + 36, "00"))
hora13 = b + TimeValue("00:00:" & Format(x + 39, "00"))
hora14 = b + TimeValue("00:00:" & Format(x + 40, "00"))
Usuario = Application.UserName & " " & Format(Cells(i, 9).Value, "yyyy-mm-dd") & " "
Cells(i, 3).AddComment
Cells(i, 3).Comment.Text Text:=Usuario & " " & Format(hora, "h:mm:ss am/pm") & " " & Cells(i, 3).Text
Cells(i + 1, 3).AddComment
Cells(i + 1, 3).Comment.Text Text:=Usuario & " " & Format(hora1, "h:mm:ss am/pm") & " " & Cells(i + 1, 3).Text
If Cells(i + 2, 3).Text = Empty Then
Cells(i + 2, 3).FormulaR1C1 = ""
Else
Cells(i + 2, 3).AddComment
Cells(i + 2, 3).Comment.Text Text:=Usuario & " " & Format(hora2, "h:mm:ss am/pm") & " " & Cells(i + 2, 3).Text
End If
Cells(i, 4).AddComment
Cells(i, 4).Comment.Text Text:=Usuario & " " & Format(hora3, "h:mm:ss am/pm") & " " & Cells(i, 4).Text
Cells(i, 5).AddComment
Cells(i, 5).Comment.Text Text:=Usuario & " " & Format(hora4, "h:mm:ss am/pm") & " " & Cells(i, 5).Text
Cells(i, 6).AddComment
Cells(i, 6).Comment.Text Text:=Usuario & " " & Format(hora5, "h:mm:ss am/pm") & " " & Cells(i, 6).Text
Cells(i, 7).AddComment
Cells(i, 7).Comment.Text Text:=Usuario & " " & Format(hora6, "h:mm:ss am/pm") & " " & Cells(i, 7).Text
Cells(i, 8).AddComment
Cells(i, 8).Comment.Text Text:=Usuario & " " & Format(hora7, "h:mm:ss am/pm") & " " & Cells(i, 8).Text
Cells(i + 1, 8).AddComment
Cells(i + 1, 8).Comment.Text Text:=Usuario & " " & Format(hora8, "h:mm:ss am/pm") & " " & Cells(i + 1, 8).Text
Cells(i, 9).AddComment
Cells(i, 9).Comment.Text Text:=Usuario & " " & Format(hora9, "h:mm:ss am/pm") & " " & Cells(i, 9).Text
Cells(i + 1, 9).AddComment
Cells(i + 1, 9).Comment.Text Text:=Usuario & " " & Format(hora10, "h:mm:ss am/pm") & " " & Cells(i + 1, 9).Text
Cells(i, 11).AddComment
Cells(i, 11).Comment.Text Text:=Usuario & " " & Format(hora11, "h:mm:ss am/pm") & " " & Cells(i, 11).Text
Cells(i + 1, 11).AddComment
Cells(i + 1, 11).Comment.Text Text:=Usuario & " " & Format(hora12, "h:mm:ss am/pm") & " " & Cells(i + 1, 11).Text
If Cells(i + 2, 11).Text = Empty Then
Cells(i + 2, 11).FormulaR1C1 = ""
Else
Cells(i + 2, 11).AddComment
Cells(i + 2, 11).Comment.Text Text:=Usuario & " " & Format(hora13, "h:mm:ss am/pm") & " " & Cells(i + 2, 11).Text
End If
Cells(i, 12).AddComment
Cells(i, 12).Comment.Text Text:=Usuario & " " & Format(hora14, "h:mm:ss am/pm") & " " & Cells(i, 12).Text
Next
MsgBox "COMPLETADO FECHA INICIAL", vbInformation, "BASE DE DATOS"
Application.ScreenUpdating = True
End Sub

1 Respuesta

Respuesta
2

Creo que, entre otras cosas, en lugar de definir una variable hora, hora1, hora2, ..., etc, podrías definir un arreglo, algo del tipo

Sub Fecha_Inicial()
Dim i As Integer
Dim hora(0 To 14) As Date
'tu código previo...
'...
x = Int(Rnd * 10)
b = TimeValue(Cells(i + 1, 9))
'cuando vas a definir todas las variables, en lugar de eso haces
For i = 0 To 14
    hora(i) = b + TimeValue("00:00:" & Format(x + i * 3, "00"))
Next i
'con las 3 lineas anteriores te eliminas todas las asignaciones de las variables horas
'la asignación de la hora a las celdas, creo que también las podrías poner en otro bucle, pero no estoy muy seguro de
'cumplir todas las propiedades, podrías probar con algo del tipo
'(empiezo en hora3, porque veo que hora2 sigue otra lógica)
For i = 4 To 8
Cells(i, i).AddComment
Cells(i, i).Comment.Text Text:=Usuario & " " & Format(hora(i - 1), "h:mm:ss am/pm") & " "
Cells(i, i).Text
Next i
End Sub

Hay un poco más de código que puede simplificarse, pero creo que con eso que te puse ya entenderás el modo de hacerlo

Salu2

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas