Neste artigo, criaremos uma macro para criar uma planilha para cada dia da semana do mês especificado do ano especificado, excluindo todas as datas especificadas na lista de feriados.
Antes de executar a macro, três entradas são necessárias. Precisamos especificar o número do mês na célula J10, ano na célula J11 e especificar a lista de datas de feriados no intervalo B16: B26.
Após especificar os valores de entrada, clique no botão enviar para executar a macro.
Esta macro irá inserir uma nova planilha para cada dia da semana do mês especificado, excluindo as datas especificadas na lista de feriados.
Explicação lógica
Nesta macro, usamos a função DateSerial para encontrar a última data do mês especificado. Usamos FOR Loop para fazer um loop da data de início do mês até a última data do mês. Usamos a função Find para descobrir se a data em uso existe na lista de feriados especificada.
A função de dia da semana é usada junto com a instrução If para verificar se uma data é dia da semana ou fim de semana. A instrução if irá inserir uma nova planilha apenas se a data for um dia da semana e não existir na lista de feriados. Como se pode ver na imagem acima, folha para 6º Dezembro não é criado, pois 6º Dezembro está presente na lista de feriados.
Siga abaixo para o código
Option Explicit Sub MonthApply () 'Declarando variáveis Dim DVariable As Date Dim RngFind As Range Dim MonthNo, YearNo As Integer Dim StartDate, EndDate as Date' Desativando as atualizações de tela Application.ScreenUpdating = False With Worksheets ("Main") 'Obtendo o mês e ano da célula J10 e J11 da planilha "Principal" MonthNo = .Range ("J10"). Value YearNo = .Range ("J11"). Value 'Derivando as datas de início e término StartDate = DateSerial (YearNo, MonthNo, 1) EndDate = DateSerial (YearNo, MonthNo + 1, 0) 'Looping por todas as datas no mês especificado For DVariable = StartDate To EndDate' Encontrar se a data está marcada como feriado Defina RngFind = .Range ("B16: B26"). Find ( DVariable) 'Verificando se a data é feriado, fim de semana ou dia da semana If RngFind Is Nothing And Weekday (DVariable, 2) <6 Then' Inserir nova planilha após a última planilha na planilha Worksheets.Add after: = Worksheets (Worksheets.Count) ' Renomeando a planilha ativa ActiveSheet.Name = Format (DVariable, "dd.mm.yy") End If Next DVariable .Select End W com Application.ScreenUpdating = True End Sub
Se você gostou deste blog, compartilhe com seus amigos no Facebook. Além disso, você pode nos seguir no Twitter e no Facebook.
Gostaríamos muito de ouvir de você, diga-nos como podemos melhorar nosso trabalho e torná-lo melhor para você. Escreva para nós no site de e-mail