Vytvárajte denné listy mesiaca bez víkendov a sviatkov pomocou VBA

Anonim

V tomto článku vytvoríme makro na vytvorenie hárka pre každý deň v týždni pre určený mesiac uvedeného roka s vylúčením všetkých dátumov uvedených v zozname sviatkov.

Pred spustením makra sú potrebné tri vstupy. Do bunky J10 musíme zadať číslo mesiaca, do bunky J11 rok a v zozname B16: B26 špecifikovať zoznam dátumov sviatkov.

Po zadaní vstupných hodnôt spustíte makro kliknutím na tlačidlo Odoslať.

Toto makro vloží nový hárok pre každý pracovný deň v určený mesiac s výnimkou dátumov uvedených v zozname sviatkov.

Logické vysvetlenie

V tomto makre sme použili funkciu DateSerial na nájdenie posledného dátumu uvedeného mesiaca. Na slučku od začiatku dátumu v mesiaci do posledného dátumu mesiaca sme použili slučku FOR. Použili sme funkciu Hľadať, aby sme zistili, či sa v uvedenom zozname sviatkov nachádza použitý dátum.

Funkcia Weekday sa používa spolu s príkazom If na kontrolu, či je dátum v týždni alebo cez víkend. Príkaz if vloží nový hárok iba vtedy, ak je dátum dňom v týždni a neexistuje v zozname sviatkov. Ako je možné vidieť na obrázku vyššie, list pre 6th December nie je vytvorený, pretože 6th December je v zozname dovoleniek.

Pri kódovaní postupujte podľa nižšie uvedených pokynov

 Možnosť Explicitný čiastkový mesiacAplikácia () 'Deklarovanie premenných Dim DVariable ako dátum Dim RngFind ako rozsah Dim Monthno, YearNo As Integer Dim StartDate, EndDate As Date' Zakázanie aktualizácií obrazovky Application.ScreenUpdating = False With worksheets ("Main") 'Získanie mesiaca a rok z bunky J10 a J11 z „hlavného“ listu MonthNo = .Range („J10“). Hodnota YearNo = .Range („J11“). Hodnota „Odvodenie dátumu začiatku a konca StartDate = DateSerial (YearNo, MonthNo, 1) EndDate = DateSerial (YearNo, MonthNo + 1, 0) 'Opakovanie všetkých dátumov v určenom mesiaci pre DVariable = StartDate To EndDate' Zistenie, či je dátum označený ako sviatok Set RngFind = .Range ("B16: B26"). Nájsť ( DVariable) 'Kontrola, či je dátum sviatok, víkend alebo pracovný deň, ak je RngFind nič a deň v týždni (DVariable, 2) <6 Potom' Vloženie nového hárka za posledný pracovný hárok do pracovných zošitov. Pridať po: = Pracovné listy (Worksheets.Count) ' Premenovanie aktívneho hárka ActiveSheet.Name = Formát (DVariable, "dd.mm.yy") Koniec Ak nasledujúci DVariable. Vyberte Koniec W ith Application.ScreenUpdating = True End Sub 

Ak sa vám tento blog páčil, zdieľajte ho so svojimi priateľmi na Facebooku. Môžete nás tiež sledovať na Twitteri a Facebooku.

Budeme radi, ak sa nám ozvete, dajte nám vedieť, ako môžeme zlepšiť našu prácu a zlepšiť ju pre vás. Napíšte nám na emailovú stránku