Notifications
Clear all

otimizar macro para datas (dia da semana)

3 Posts
2 Usuários
0 Reactions
871 Visualizações
(@edcronos)
Posts: 1006
Noble Member
Topic starter
 

ola.

fiz uma macro que preenche um setor da ultima linha até a linha selecionada acompanhando os valores

no caso eu escolho os dias da semana que vai ter em caixas de seleção num userform
tipo todos os domingos e terças
então a partir da ultima data já preenchida até a linha selecionada, naquela coluna vai ter as datas que sejam os dias da semanas escolhidos
está funcionando, mas quando escolho uma faixa muito grande demora um pouco para completar o preenchimento
creio que é por causa do loop para comparar se a data corresponde a um dos dias da semana escolhido.

Private Sub Treencher_set_Click()
Dim ds(1 To 7) As Byte
   Inicio
    Cs = Cells(10, Selection.Column).Value2

    Cs = Cells(1, Cs).Column
    If Cs > 0 And Cs < 13 Then SetorL Cs Else: Exit Sub

    For N = 1 To 7
        Sety = "cds" & N
        If Me.Controls(Sety) = True Then ds(N) = N Else ds(N) = 0
    Next
 Lf = Selection.row
    Li = Cells(Lf, Selection.Column).End(xlUp).row + 1
    Lt = Lf - Li
    VL = Cells(Li - 1, Ti).Value2 + 1
    dst = Cells(Li - 1, CD).Value
    i = 0
    For vt = VL To VL + Lt
        Cells(Li + i, Ti).Value2 = vt
        Range(Ci & Li + i, Cf & Li + i).Value2 = "x"
t = 0
        For N = 1 To 7
            dst = DateAdd("d", 1, dst)
            dsl = Weekday(dst)
            For ji = 1 To 7
                If dsl = ds(ji) Then t = 1: Exit For
            Next
            If t = 1 Then t = 0: Cells(Li + i, CD).Value = dst: Exit For
        Next
        i = i + 1
    Next

    Final
End Sub

dst = Cells(Li - 1, CD).Value "aqui pega a ultima data "

t = 0
For N = 1 To 7
dst = DateAdd("d", 1, dst)
dsl = Weekday(dst)

For ji = 1 To 7 "loop para comparar se a data corresponde a um dia da semana escolhido"
If dsl = ds(ji) Then t = 1: Exit For
Next

If t = 1 Then t = 0: Cells(Li + i, CD).Value = dst: Exit For "se a data fo um dia da semana escolhido adiciona na celula"
Next
i = i + 1" pula linha"
Next

 
Postado : 24/10/2014 11:28 am
(@rlm)
Posts: 0
New Member
 

Ficar acompanhando o código somente sem conhecer as variantes, fica um tanto quanto difícil dar um palpite, poderia postar um modelo com alguns dados?

 
Postado : 24/10/2014 3:15 pm
(@edcronos)
Posts: 1006
Noble Member
Topic starter
 

ola. reinaldo
obrigado, eu já consegui resolver, era as formatações condicionais que deixava o codigo lento, como eu já tinha macro que tira e reaplica as formatações condicionais eu adicionei na macro e melhorou bastante
tem casos que
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
não resolve
tem formulas que eu tive que fazer gravar em um array para depois aplicar todo de uma vez na planilha para não demorar

 
Postado : 24/10/2014 4:48 pm