3

Necesito hacer que Excel ejecute más rápido el código así que necesito optimizarlo.

Private Sub CommandButton1_Click()
    Dim fecha As Date, mes As String
    fecha = "1/1/" & Sheets("QUADRANT").Range("B9")
    fechaFin = "31/12/" & Sheets("QUADRANT").Range("B9")
    mesNum = -1
    For i = fecha To fechaFin
        mesNum1 = Month(i)
        If mesNum1 <> mesNum2 Then
            mesNum2 = mesNum1
            If mesNum2 = 1 Then
                mes = "GENER"
            ElseIf mesNum2 = 2 Then
                mes = "FEBRER"
            ElseIf mesNum2 = 3 Then
                mes = "MARÇ"
            ElseIf mesNum2 = 4 Then
                mes = "ABRIL"
            ElseIf mesNum2 = 5 Then
                mes = "MAIG"
            ElseIf mesNum2 = 6 Then
                mes = "JUNY"
            ElseIf mesNum2 = 7 Then
                mes = "JULIOL"
            ElseIf mesNum2 = 8 Then
                mes = "AGOST"
            ElseIf mesNum2 = 9 Then
                mes = "SETEMBRE"
            ElseIf mesNum2 = 10 Then
                mes = "OCTUBRE"
            ElseIf mesNum2 = 11 Then
                mes = "NOVEMBRE"
            ElseIf mesNum2 = 12 Then
                mes = "DESEMBRE"
            End If

Esta parte parece que se puede resumir mucho más de lo que está.

Nota: Los meses están en catalán.

Sheets(mes).Range("A6:P300").Clear
            Sheets(mes).Range("6:300").RowHeight = 20
        End If

    y = 4 + 7 * Month(i)
    x = 3 + Day(i)

    If Sheets("QUADRANT").Cells(y - 1, x).Font.ColorIndex = 7 Or Weekday(i, vbMonday) = 6 Or Weekday(i, vbMonday) = 7 Then
        Sheets("MACROS").Range("B28:Q35").Copy
        Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).PasteSpecial Paste:=xlPasteAll
    Else
        Sheets("MACROS").Range("B18:Q25").Copy
        Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).PasteSpecial Paste:=xlPasteAll
    End If

    If Weekday(i, vbMonday) = 1 Then
        Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).Value = "Lunes"
    ElseIf Weekday(i, vbMonday) = 2 Then
        Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).Value = "Martes"
    ElseIf Weekday(i, vbMonday) = 3 Then
        Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).Value = "Miercoles"
    ElseIf Weekday(i, vbMonday) = 4 Then
        Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).Value = "Jueves"
    ElseIf Weekday(i, vbMonday) = 5 Then
        Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).Value = "Viernes"
    ElseIf Weekday(i, vbMonday) = 6 Then
        Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).Value = "Sabado"
    ElseIf Weekday(i, vbMonday) = 7 Then
        Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).Value = "Domingo"
    End If

Esta parte del final es la que creo que se puede resumir más.

6
  • Esto es parte de un código mayor, se puede reducir a una sola línea, pero podrías por favor poner el código completo para ver qué te está ralentizando?
    – Damian
    Commented el 2 dic. 2019 a las 10:52
  • El codigo es demasiado extenso pero si realmente quieres que lo ponga lo pongo pero dices que se puede reducir a una linea como se hace?
    – user151279
    Commented el 2 dic. 2019 a las 11:01
  • Por eso necesito ver más código... qué valor tiene la i? una fecha?
    – Damian
    Commented el 2 dic. 2019 a las 11:01
  • he puesto un poco mas del codigo
    – user151279
    Commented el 2 dic. 2019 a las 11:22
  • Iker, te he dejado editada mi respuesta con el código para los meses. Si fueran en castellano te serviría lo mismo que con los días de la semana: Format(i, "mmmm") en este caso.
    – Damian
    Commented el 2 dic. 2019 a las 11:40

2 respuestas 2

6

Sólo con lo que has puesto y entendiendo que el valor de i es una fecha, puedes cargarte el condicional completo y reducirlo a esto:

Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).Value = Format(i, "dddd")

Le das formato dddd a la fecha, convirtiéndola en el día de la semana completo (en minúsculas y con tildes donde proceda). No obstante, dudo mucho que esta parte de tu código ralentice el proceso tanto.

Edito:

Para los meses, al ser en catalán no te queda otra que hacer un array con los nombres, pero puedes hacer así para luego asignarlos:

Option Explicit
Sub Test()

    Dim Meses As Variant
    Meses = Array("GENER", "FEBRER", "MARÇ", "ABRIL", "MAIG", "JUNY", "JULIOL", "AGOST", "SEPTEMBRE", "OCUTBRE", "NOVEMBRE", _
        "DESEMBRE")
    Dim mesNum As Long
    For i = fecha To fechaFin
        mesNum = Month(i) - 1
        mes = Meses(mesNum)

        '...

        Sheets(mes).Range("A" & 6 + (Day(i) - 1) * 9).Value = Format(i, "dddd")
    Next i

End Sub

como el array empieza en la posición 0, restas 1 al mes que te da la función Month() y ya queda igualado para dar automáticamente lo que necesitas.

1

De todas formas, si lo que pretendes es obtener el nombre del mes, en VBA existe la función Monthname().

Escribiendo:

MiMes = monthname(Month(date))

Esto te devolvería el nombre completo del mes: diciembre

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.