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
Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.
"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"
Postado : 24/10/2014 11:28 am