W tym artykule utworzymy makro do tworzenia arkusza dla każdego dnia tygodnia dla określonego miesiąca określonego roku z wyłączeniem wszystkich dat określonych na liście świąt.
Przed uruchomieniem makra wymagane są trzy dane wejściowe. Musimy określić numer miesiąca w komórce J10, rok w komórce J11 i określić listę dat świąt w zakresie B16:B26.
Po określeniu wartości wejściowych kliknij przycisk przesyłania, aby uruchomić makro.
To makro wstawi nowy arkusz dla każdego dnia tygodnia w określonym miesiącu z wyjątkiem dat określonych na liście dni wolnych.
Wyjaśnienie logiczne
W tym makrze użyliśmy funkcji DateSerial, aby znaleźć ostatnią datę podanego miesiąca. Użyliśmy pętli FOR do pętli od daty początkowej miesiąca do ostatniego dnia miesiąca. Użyliśmy funkcji Znajdź, aby sprawdzić, czy używana data istnieje na określonej liście świąt.
Funkcja dni tygodnia jest używana wraz z instrukcją If, aby sprawdzić, czy data jest dniem tygodnia czy weekendem. Wyciąg If wstawi nowy arkusz tylko wtedy, gdy data jest dniem tygodnia i nie istnieje na liście świąt. Jak widać na powyższym zrzucie, arkusz dla 6NS Grudzień nie jest tworzony, ponieważ 6NS Grudzień jest obecny na liście świątecznych.
Proszę postępować zgodnie z poniższym kodem!
Option Explicit Sub MonthApply() 'Deklarowanie zmiennych Dim DVariable As Date Dim RngFind As Range Dim MonthNo, YearNo As Integer Dim StartDate, EndDate As Date 'Wyłączanie aktualizacji ekranu Application.ScreenUpdating = False With Worksheets("Main") 'Pobieranie miesiąca i rok z komórki J10 i J11 z arkusza „Main” MonthNo = .Range("J10").Value YearNo = .Range("J11").Value 'Wyprowadzanie daty rozpoczęcia i zakończenia StartDate = DateSerial(YearNo, MonthNo, 1) EndDate = DateSerial(YearNo, MonthNo + 1, 0) 'Przeglądanie wszystkich dat w określonym miesiącu For DVariable = StartDate To EndDate 'Sprawdzanie, czy data jest oznaczona jako dzień wolny Set RngFind = .Range("B16:B26").Find( DVariable) 'Sprawdzanie, czy data to święto, weekend lub dzień tygodnia Jeśli RngFind to nic i dzień tygodnia(DVariable, 2) < 6 Następnie 'Wstawianie nowego arkusza po ostatnim arkuszu w skoroszycie Worksheets.Add after:=Worksheets(Worksheets.Count) ' Zmiana nazwy aktywnego arkusza ActiveSheet.Name = Format(DVariable, "dd.mm.yy") End If Next DVariable .Select End W ith Application.ScreenUpdating = True End Sub
Jeśli podobał Ci się ten blog, podziel się nim ze znajomymi na Facebooku. Możesz również śledzić nas na Twitterze i Facebooku.
Chcielibyśmy usłyszeć od Ciebie, daj nam znać, jak możemy poprawić naszą pracę i uczynić ją lepszą dla Ciebie. Napisz do nas na stronie e-mail