Vytvářejte denní archy měsíce bez víkendů a svátků pomocí VBA

Anonim

V tomto článku vytvoříme makro pro vytvoření listu pro každý den v týdnu pro zadaný měsíc zadaného roku s vyloučením všech dat uvedených v seznamu dovolených.

Před spuštěním makra jsou nutné tři vstupy. Potřebujeme zadat číslo měsíce v buňce J10, rok v buňce J11 a zadat seznam dnů prázdnin v rozsahu B16: B26.

Po zadání vstupních hodnot spustíte makro kliknutím na tlačítko Odeslat.

Toto makro vloží nový list pro každý den v týdnu pro zadaný měsíc bez dat uvedených v seznamu svátků.

Logické vysvětlení

V tomto makru jsme použili funkci DateSerial k nalezení posledního data zadaného měsíce. Použili jsme FOR Loop pro smyčku od počátečního data měsíce do posledního data v měsíci. Použili jsme funkci Najít, abychom zjistili, zda použité datum existuje v uvedeném seznamu svátků.

Funkce Weekday se používá společně s příkazem If ke kontrole, zda je datum ve všední den nebo o víkendu. Pokud příkaz vloží nový list, pouze pokud je datum ve všední den a neexistuje v seznamu svátků. Jak je vidět na výše uvedeném snímku obrazovky, list pro 6th Prosinec není vytvořen, protože 6th Prosinec je uveden v seznamu dovolených.

Pro kód prosím postupujte níže

 Možnost Explicitní dílčí měsíční aplikace () 'Deklarace proměnných Dim DVariable jako datum Dim RngFind jako rozsah Dim MonthNo, YearNo As Integer Dim StartDate, EndDate As Date' Zakázání aktualizací obrazovky Application.ScreenUpdating = False With worksheets ("Main") 'Získání měsíce a rok z buňky J10 a J11 z listu „Hlavní“ MonthNo = .Range („J10“). Hodnota YearNo = .Range („J11“). Hodnota „Odvození počátečního a koncového data StartDate = DateSerial (YearNo, MonthNo, 1) EndDate = DateSerial (YearNo, MonthNo + 1, 0) 'Looping through the date in the specified month For DVariable = StartDate To EndDate' Finding if date is identified as holiday Set RngFind = .Range ("B16: B26"). Find ( DVariable) 'Kontrola, zda je datum svátek, víkend nebo všední den, pokud je RngFind nic a všední den (DVariable, 2) <6 Potom' Vložení nového listu za poslední list v sešitech. Přidat po: = Pracovní listy (Worksheets.Count) ' Přejmenování aktivního listu ActiveSheet.Name = Format (DVariable, "dd.mm.yy") End If Next DVariable. Vyberte End W ith Application.ScreenUpdating = True End Sub 

Pokud se vám tento blog líbil, sdílejte ho se svými přáteli na Facebooku. Také nás můžete sledovat na Twitteru a Facebooku.

Rádi bychom od vás slyšeli, dejte nám vědět, jak můžeme zlepšit naši práci a zlepšit ji pro vás. Napište nám na e -mail