I denne artikel opretter vi en makro til at oprette et ark for hver hverdag i den angivne måned i det angivne år eksklusive alle de datoer, der er angivet på ferielisten.
Inden makroen køres, kræves tre input. Vi skal angive månedstallet i celle J10, år i celle J11 og angive listen over feriedatoer i området B16: B26.
Når du har angivet inputværdierne, skal du klikke på knappen Send for at køre makroen.
Denne makro indsætter et nyt ark for hver hverdag i den angivne måned eksklusive de datoer, der er angivet på ferielisten.
Logisk forklaring
I denne makro har vi brugt DateSerial -funktion til at finde den sidste dato i den angivne måned. Vi har brugt FOR Loop til loop fra månedens startdato til sidste måned i måneden. Vi har brugt Find -funktionen til at finde ud af, om den dato, der bruges, findes i den angivne ferieliste.
Ugedag -funktion bruges sammen med If -erklæring for at kontrollere, om en dato er hverdag eller weekend. Hvis erklæringen kun vil indsætte et nyt ark, hvis datoen er en hverdag, og den ikke findes på ferielisten. Som man kan se på ovenstående skærmbillede, ark til 6th December oprettes ikke, da 6th December findes på ferielisten.
Følg venligst nedenstående for koden
Option Eksplicit undermåned Anvend () 'Deklarationsvariabler Dim DVariable As Date Dim RngFind As Range Dim MonthNo, YearNo As Integer Dim StartDate, EndDate As Date' Deaktivering af skærmopdateringer Application.ScreenUpdating = False With Worksheets ("Main") 'Få måned og år fra celle J10 og J11 fra "Main" -bladet MonthNo = .Range ("J10"). Værdi YearNo = .Range ("J11"). Value 'Afledende start- og slutdato 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) 'Kontrol af, om dato er ferie, weekend eller hverdag, hvis RngFind er ingenting og ugedag (DVariable, 2) <6 Derefter' Indsætning af nyt ark efter det sidste regneark i projektmappen. Omdøbning af det aktive ark ActiveSheet.Name = Format (DVariable, "dd.mm.yy") End If Next DVariable .Vælg End W ith Application.ScreenUpdating = True End Sub
Hvis du kunne lide denne blog, kan du dele den med dine venner på Facebook. Du kan også følge os på Twitter og Facebook.
Vi vil meget gerne høre fra dig, lad os vide, hvordan vi kan forbedre vores arbejde og gøre det bedre for dig. Skriv til os på e -mail -stedet