Создать день листов в месяц без выходных и праздников с использованием VBA
В этой статье мы создадим макрос для создания листа для каждого дня недели для указанного месяца указанного года, за исключением всех дат, указанных в списке праздников.
Перед запуском макроса требуются три входа. Нам нужно указать номер месяца в ячейке J10, год в ячейке J11 и указать список праздничных дат в диапазоне B16: B26.
После указания входных значений нажмите кнопку отправки, чтобы запустить макрос.
Этот макрос вставит новый лист для каждого дня недели указанного месяца, за исключением дат, указанных в списке праздников.
Логическое объяснение
В этом макросе мы использовали функцию DateSerial, чтобы найти последнюю дату указанного месяца. Мы использовали цикл FOR для цикла от даты начала месяца до последней даты месяца. Мы использовали функцию поиска, чтобы определить, существует ли используемая дата в указанном списке праздников.
[_GoBack] # Функция Weekday используется вместе с оператором If для проверки того, является ли дата будним или выходным днем. Оператор If вставит новый лист только в том случае, если дата — будний день, и его нет в списке праздников. Как видно на скриншоте выше, лист на 6 ^ ^ декабря не создается, так как 6 ^ ^ декабрь присутствует в списке праздников.
Пожалуйста, введите код ниже
Option Explicit Sub MonthApply() 'Declaring variables Dim DVariable As Date Dim RngFind As Range Dim MonthNo, YearNo As Integer Dim StartDate, EndDate As Date 'Disabling the screen updates Application.ScreenUpdating = False With Worksheets("Main") 'Getting month and year from cell J10 and J11 from "Main" sheet MonthNo = .Range("J10").Value YearNo = .Range("J11").Value 'Deriving start and end date StartDate = DateSerial(YearNo, MonthNo, 1) EndDate = DateSerial(YearNo, MonthNo + 1, 0) 'Looping through all the dates in the specified month For DVariable = StartDate To EndDate 'Finding if date is marked as holiday Set RngFind = .Range("B16:B26").Find(DVariable) 'Checking whether date is holiday, weekend or weekday If RngFind Is Nothing And Weekday(DVariable, 2) < 6 Then 'Inserting new sheet after the last worksheet in the workbook Worksheets.Add after:=Worksheets(Worksheets.Count) 'Renaming the active sheet ActiveSheet.Name = Format(DVariable, "dd.mm.yy") End If Next DVariable .Select End With Application.ScreenUpdating = True End Sub
Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.
Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]