Este fórum está sendo desativado

[JCabral]

Boa tarde

Mais uma vez pedindo ajuda.
Tenho uma Timeline que é gerada em função de um determinado ano, apresento na Planilha anexa um exemplo para o ANO 2019, porque tem todos os casos que quero mostrar.

O que preciso é que para cada mês escrever nas linhas 17/18 o titulo "ROTEIROS", só nos dias uteis (centrado) ou seja de segunda a sexta feira, contudo quando a primeira semana do mês "x" só tem um ou dois dias uteis quero que seja escrito apenas "ROT" - ver p.ex. mês de FEVEREIRO que na primeira semana só tem um dia útil - o mesmo se aplica para a ultima semana do mês, ou seja se tiver apenas um ou dois dias apenas escreve "ROT" - ver p.ex. mês de Abril -, todas as semanas entre a primeira e a ultima têm cinco dias úteis (não interessam feriados)

Preciso que assim seja porque como podem ver pela Macro "HIDE_SHOW_Columns" eu pretendo mostrar apenas um mês de cada vês e assim pretendo que no inicio e fim de cada mês apareça o titulo conforme os dias que tenho.

Na planilha que anexo mostro o que tenho no Range("J6:NM22") e o que se pretende no Range("J26:NM42")

NOTA: Este Timeline não é fixo ele é gerado em função do ano.

Desde já agradeço
Jorge Cabral

[osvaldomp]

Salve, Jorge.

Experimente o código abaixo. Não fiz testes com outros anos além de 2019, que está no seu exemplo.

Código: Selecionar todos

Sub InsereRoteiros()
 Dim i As Long, fs As Long, k As Long, ini As Long, LC As Long, d As Date, m As Long
  
  Application.ScreenUpdating = False
  Rows(17).UnMerge: Rows(17).ClearContents

  'tratamento da primeira semana
  k = k - (Weekday([M7], 2) = 6) * 2 - (Weekday([M7], 2) = 7) * 1
  i = 13 + k
  fs = Day(Range("M7").Value + 8 - Weekday(Range("M7").Value + 1)) - 1
   With Cells(17, i)
    .Value = IIf(fs >= 3, "ROTEIROS", "ROT")
    .Resize(2, fs - k).Merge
    .HorizontalAlignment = xlCenter
   End With
   
  'tratamento da segunda até a penúltima semana
  LC = Cells(7, Columns.Count).End(1).Column
  d = Evaluate("" & Cells(7, LC).Address & "-weekday(" & Cells(7, LC).Address & ")")
  m = Rows(7).Find(d).Column
  For ini = 13 + fs + 2 To m Step 7
   fs = Evaluate("SUMPRODUCT((MONTH(" & Cells(7, ini).Address & ":" & Cells(7, ini + 4) _
    .Address & ")=MONTH(" & Cells(7, ini).Address & "))*(MONTH(" & Cells(7, ini).Address & ":" & _
     Cells(7, ini + 4).Address & ")=MONTH(" & Cells(7, ini).Address & ")))")
   If fs = 5 Then
    With Cells(17, ini)
     .Value = IIf(fs >= 3, "ROTEIROS", "ROT")
     .Resize(2, 5).Merge
     .HorizontalAlignment = xlCenter
    End With
   Else:
    With Cells(17, ini)
    .Value = IIf(fs >= 3, "ROTEIROS", "ROT")
    .Resize(2, fs).Merge
    .HorizontalAlignment = xlCenter
    End With
    With Cells(17, ini + fs)
    .Value = IIf(5 - fs >= 3, "ROTEIROS", "ROT")
    .Resize(2, 5 - fs).Merge
    .HorizontalAlignment = xlCenter
    End With
   End If
  Next ini
  
  'tratmento da última semana
  With Cells(17, m + 2)
    .Value = IIf(LC - (m + 1) >= 3, "ROTEIROS", "ROT")
    .Resize(2, LC - (m + 1)).Merge
    .HorizontalAlignment = xlCenter
  End With
End Sub

[JCabral]

Boa tarde Osvaldo

Muito obrigado mais uma vez.

Testei em 2020 e 2021 e tudo ok, mas em 2017 e 2022 deu erro na ultima semana do ano, anexo ficheiro com os erros que deram.

Ainda não estudei todo o seu código mas já fiz uma pequena alteração porque entretanto alterei o Layout da Timeline ou seja ROT/ROTEIROS só será escrito na linha 17 já que na linha 18 passaram a estar Listas de Validação que estou a tentar também automatizar a sua inclusão nos dias úteis de cada mês.

Abraço
Jorge Cabral

[osvaldomp]

... mas em 2017 e 2022 deu erro na ultima semana do ano, ...

Olá, Jorge .
No trecho do código que trata da última semana, substitua esta linha ~~~> .Resize(2, LC - (m + 1)).Merge
por esta ~~~> .Resize(2, LC - (m + 1) + (Weekday(Cells(7, LC), 2) = 6) * 1 - (Weekday(Cells(7, LC), 2) = 7) * 2).Merge

[JCabral]

Obrigado pela resposta Osvaldo, mas em 2017 continua o mesmo erro, ou seja escreve ROT depois do ultimo dia do mês de Dezembro.

Ou seja sempre que os últimos dois dias do ano sejam Sáb. e Dom., dá erro, vi agora que 2023 é igual

[osvaldomp]

Olá, Jorge.

Caso não tenha resolvido, experimente substituir pelo trecho abaixo o trecho referente ao tratamento da última semana.

Código: Selecionar todos

  'tratmento da última semana
  fs = Evaluate("NETWORKDAYS(" & Cells(7, m).Address & "," & Cells(7, LC).Address & ")")
  If fs = 0 Then Exit Sub
  With Cells(17, m + 2)
   .Value = IIf(LC - (m + 1) >= 3, "ROTEIROS", "ROT")
   .Resize(2, fs).Merge
   .HorizontalAlignment = xlCenter
  End With

[JCabral]

Caro Osvaldo

Mais uma vez muito obrigado, ficou TOP!

Obrigado
Jorge Cabral