' 获取当月的天数 Function GetDaysOfMonth( Year As String , Month As String ) As Integer Dim Day1, Day2 As String If Month = " 12 " Then GetDaysOfMonth = 31 Day1 = Year + " - " + Month + " -1 " Day2 = Year + " - " + CStr ( CInt ( Month ) + 1 ) + " -1 " GetDaysOfMonth = DateDiff ( " d " , Day1, Day2) End If End Function Sub AddSheets() Dim i As Integer Dim DaysOfMonth As Integer Dim NameStr As String Dim DateStr As String Dim CurrMonth As Integer Dim MonStr As String Dim CurrYear As String Dim Choice As Integer Dim LastMonth As Integer Dim OriginSheet As String Application.DisplayAlerts = False For i = Sheets.Count To 1 Step - 1 If Sheets(i).Name <> ActiveSheet.Name Then Sheets(i).Delete End If ActiveSheet.Name = " LastSheet " OriginSheet = ActiveSheet.Name CurrMonth = CInt ( Month (Now)) ' 设置起始及结束月份(1-12); 默认当前月 StartMonth = CurrMonth LastMonth = CurrMonth CurrYear = CStr ( Year (Now)) For m = StartMonth To LastMonth MonStr = CStr (m) DaysOfMonth = GetDaysOfMonth(CurrYear, MonStr) For i = 1 To DaysOfMonth Worksheets.Add after: = Worksheets(Worksheets.Count) NameStr = MonStr & " - " & CStr (i) DateStr = CurrYear & " - " & NameStr ActiveSheet.Name = NameStr ActiveSheet.[A1].Value = DateStr ActiveSheet.[B1].Value = " 星期 " & disp( Weekday (DateStr, vbMonday)) ' 设置单元格行列宽高自适应 ActiveSheet.[A1].Columns.AutoFit ActiveSheet.[A1].Rows.AutoFit ActiveSheet.[B1].Columns.AutoFit ActiveSheet.[B1].Rows.AutoFit Sheets(OriginSheet).Delete On Error Resume Next Application.DisplayAlerts = True End Sub

2.  生成直到2099年的日期及月份，每个月份一个 Excel

' 获取星期的显示
Function disp(i As Integer)
  Select Case i
     Case 1
       disp = "一"
     Case 2
       disp = "二"
     Case 3
       disp = "三"
     Case 4
       disp = "四"
     Case 5
       disp = "五"
     Case 6
       disp = "六"
     Case Else
       disp = "日"
  End Select
End Function
' 获取当月的天数
Function GetDaysOfMonth(Year As String, Month As String) As Integer
    Dim Day1, Day2 As String
    If Month = "12" Then
        GetDaysOfMonth = 31
        Day1 = Year + "-" + Month + "-1"
        Day2 = Year + "-" + CStr(CInt(Month) + 1) + "-1"
        GetDaysOfMonth = DateDiff("d", Day1, Day2)
    End If
End Function
Sub AddSheets(Year As String, Month As String)
    Dim i As Integer
    Dim DaysOfMonth As Integer
    Dim NameStr As String
    Dim DateStr As String
    Dim CurrMonth As Integer
    Dim MonStr As String
    Dim OriginSheet As String
    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name <> ActiveSheet.Name Then
            Sheets(i).Delete
        End If
    ActiveSheet.Name = "LastSheet"
    OriginSheet = ActiveSheet.Name
    MonStr = CStr(Month)
    DaysOfMonth = GetDaysOfMonth(Year, MonStr)
    For i = 1 To DaysOfMonth
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        NameStr = MonStr & "-" & CStr(i)
        DateStr = Year & "-" & NameStr
        ActiveSheet.Name = NameStr
        ActiveSheet.[A1].Value = DateStr
        ActiveSheet.[B1].Value = "星期" & disp(Weekday(DateStr, vbMonday))
        ' 设置单元格行列宽高自适应
        ActiveSheet.[A1].Columns.AutoFit
        ActiveSheet.[A1].Rows.AutoFit
        ActiveSheet.[B1].Columns.AutoFit
        ActiveSheet.[B1].Rows.AutoFit
    Sheets(OriginSheet).Delete
    On Error Resume Next
End Sub
Sub AddExcels(Year As String)
    Dim wb As Workbook
    Dim wbname As String
    Dim m As Integer
    Dim Month As String
    For m = 1 To 12
        Set wb = Workbooks.Add
        Month = CStr(m)
        Call AddSheets(Year, Month)
        wbname = Year & "年" & CStr(Month) & "月.xlsx"
        wb.SaveAs "d:\" & wbname
        Workbooks(wbname).Close (True)
End Sub
Sub AddExcels2099()
    Dim Year As Integer
    Application.DisplayAlerts = False
    For Year = 2016 To 2099
        AddExcels (CStr(Year))
    Workbooks(ActiveWorkbook.Name).Close (False)
    Application.DisplayAlerts = True
End Sub

(1)  函数返回值，使用函数名作为变量在最后一行赋值；

(2)  调用过程： CALL SubName(ArgList) ；

(3)  变量名、函数名习惯大写；

(4)  Switch , If, For , Sub, Function 定义代码里有；

(5)  整数转字符串 CStr,  字符串转整数 CInt ； 字符串连接 & ;

(6)  当前活动工作表 ActiveSheet , 当前活动工作簿： ActiveWorkBook ;

(7)  操作当前活动工作表： ActiveSheet.Name,  ActiveSheet.[CellID].Value ; ActiveSheet.[A1].Columns, ActiveSheet.[A1].Rows 行列设置；

(8)  工作簿操作：  新增 Set wb = Workbooks.Add ; 保存 wb SaveAs "Path/file.xlsx" ;  关闭  Workbooks(wbname).Close (True) .

无论怎样的编程语言， 函数或过程复用是最基本的技能；

只要是在计算设备上， 99%的人工操作均可自动化。