每个月的date分开

我正在尝试为每个月单独创builddate。 我已经完成了一些工作,但是寻找优化的代码。

脚步

Create a Spreadsheet and change the name from "Sheet1" to "Year" Column A ColumnB 2014 January February March April May June July August September October November December 

现在复制下面的VBA模块

 Sub GenerateDate() Dim amonth As String Dim col, cola As String Dim ayear As Integer For x = 1 To 12 Worksheets("Year").Select Worksheets("Year").Activate '//this will add every month worksheet Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Cells(x, 2) Worksheets("Year").Activate '//get month name to string called amonth// amonth = Cells(x, 2).Value '//get year to variable type int called ayear// ayear = Cells(1, 1).Value '//activate month sheet Worksheets(amonth).Activate '//insert date 1st day of each month in cell A1 Cells(1, 1).Value = DateSerial(ayear, x, 1) '//select 'A1' cell values Cells(1, 1).Select '// pass A1 value to a my_date my_date = Cells(1, 1).Value '//change the format of the date in A1 cell Selection.NumberFormat = "d/mm/yyyy;@" '//count number of days in month for the date in A1 numof_days = Day(DateSerial(Year(my_date), Month(my_date) + 1, 1) - 1) '// col a and cola are two strings holds sting values "A" and "A1" respectively col = "A" cola = "A1" '//Final value is range to be used to fill the dates Final = col & numof_days '//fill dates from A1 to Final cell values With Range("A1") .AutoFill Destination:=Range(cola, Final), Type:=xlFillDays End With '//auto fit the entire "A" column Columns("A:A").EntireColumn.AutoFit Next x End Sub 

我的输出

为每个月份创build新工作表,并仅为该月份生成date。

作为第一步,您可能会发现在代码的开始处添加application.screenupdating = false,然后在最后添加application.screenupdating = true会更有效。 这将加快您的代码。 你也可以考虑为application.displayalerts做同样的事情。