Question

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

步骤

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

我的输出

为每个月创建新工作表，并仅为该月生成日期。

Answer 1

作为第一步，您可能会发现在代码开头添加application.screenupdating = false然后在结尾处添加application.screenupdating = true会更有效。这将加快您的代码。您也可以考虑对application.displayalerts执行相同的操作。

每个月的日期在单独的表格中

1 个答案: