使用VBA设计通用的一键生成任意月份值班表

##使用VBA设计通用的一键生成任意月份值班表
一、值班分组表

说明：对行数、列数无限制，列内容无限制，第一行要求为标题行，每组占一行。
二、生成样表

说明：前四列分别为：年份‘月份、日期、星期，后面为原表数据
三、代码实现

说明：起始日期为第一组开始的第一个日期
生成年月份为开始日期后的年月份。年份要求是4位年份。

Private Sub CommandButton1_Click()
'检查
    Dim StartDate As Date
    Dim GenerateYear As Integer
    Dim GenerateMonth As Integer
    
    StartDate = ThisWorkbook.Sheets("领导分组").Range("startDate").Value
    GenerateYear = ThisWorkbook.Sheets("领导分组").Range("GenerateYear").Value
    GenerateMonth = ThisWorkbook.Sheets("领导分组").Range("GenerateMonth").Value

    If IsEmpty(StartDate) Or IsEmpty(GenerateYear) Or IsEmpty(GenerateMonth) Then
          'MsgBox "请填写基础数据"
          Exit Sub
    End If

 '新增该月份工作表
  Dim SheetName As String
  SheetName = GenerateYear & "年" & GenerateMonth & "月"
  
  ' 遍历工作簿中的所有工作表，检查是否存在
  For Each ws In ThisWorkbook.Sheets
        If ws.Name = SheetName Then
            MsgBox "工作表 " & SheetName & " 存在。"
            Exit Sub
        End If
  Next ws
    
  Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName

'生成月份第一天格式转换
Dim GenerateFirst As Date
GenerateFirst = CDate(GenerateYear & "-" & GenerateMonth & "-" & "1")

'生成月份第一天与初始天数差

 Dim MyDateDiff As Integer
 
 MyDateDiff = DateDiff("d", StartDate, GenerateFirst)
 
 'MsgBox "与初始日期相关天数" & MyDateDiff
  
 Dim Mydays As Integer
  
  ' 计算生成月天数
 GenerateMonthDays = DateDiff("d", DateSerial(GenerateYear, GenerateMonth, 1), DateSerial(GenerateYear, GenerateMonth + 1, 1))
 'MsgBox "生成月份天数" & GenerateMonthDays
 
 '取得值班组数
 Dim DutyGroups As Integer
 
 DutyGroups = ThisWorkbook.Sheets("领导分组").Cells(ThisWorkbook.Sheets("领导分组").Rows.Count, "A").End(xlUp).Row - 1
 
  '取得该月起始值班组数
 Dim DutyGroupStart As Integer
 
 
 
 DutyGroupStart = MyDateDiff Mod DutyGroups + 1

 'MsgBox "该月份第一天初始组号" & DutyGroupStart
 
 '设置字体
    With ThisWorkbook.Sheets(SheetName).Range("A1:Z100")  '将"A1:Z100"替换为需要设置字体的范围
        .Font.Name = "仿宋"
        .Font.Size = 14
    End With
    
  
 '取得领导分组表最大列数
 Dim DutyColumns As Integer
 DutyColumns = ThisWorkbook.Sheets("领导分组").Cells(1, ThisWorkbook.Sheets("领导分组").Columns.Count).End(xlToLeft).Column
 '添加标题
 
 ThisWorkbook.Sheets(SheetName).Range("A1").Value = "年份"
 ThisWorkbook.Sheets(SheetName).Range("B1").Value = "月份"
 ThisWorkbook.Sheets(SheetName).Range("C1").Value = "日期"
 ThisWorkbook.Sheets(SheetName).Range("D1").Value = "星期"
 
 ThisWorkbook.Sheets(SheetName).Range("E1").Resize(, DutyColumns).Value = ThisWorkbook.Sheets("领导分组").Range("A1").Resize(, DutyColumns).Value
 
 
 '循环遍历该月值班数据
 
 Dim CurryDay As Date
 
 For DateI = 1 To GenerateMonthDays
 
    ThisWorkbook.Sheets(SheetName).Cells(DateI + 1, 1).Value = GenerateYear '年份
    ThisWorkbook.Sheets(SheetName).Cells(DateI + 1, 2).Value = GenerateMonth '月份
    ThisWorkbook.Sheets(SheetName).Cells(DateI + 1, 3).Value = DateI '日期
    ThisWorkbook.Sheets(SheetName).Cells(DateI + 1, 4).Value = GetChineseWeekday(CDate(GenerateYear & "-" & GenerateMonth & "-" & DateI)) '星期
      
    'ThisWorkbook.Sheets(SheetName).Cells(DateI + 1, 5).Value = DutyGroupStart '组号
    ThisWorkbook.Sheets(SheetName).Range("E" & DateI + 1).Resize(, DutyColumns).Value = ThisWorkbook.Sheets("领导分组").Range("A" & DutyGroupStart + 1).Resize(, DutyColumns).Value
    
    DutyGroupStart = DutyGroupStart + 1
    
    If DutyGroupStart = 13 Then
        DutyGroupStart = 1
    End If
 Next
 '调整列宽
  ThisWorkbook.Sheets(SheetName).Columns("A:M").Select
  ThisWorkbook.Sheets(SheetName).Columns("A:M").EntireColumn.AutoFit
  
 '保存文件
 ActiveWorkbook.Save
 
 MsgBox "生成完毕，文件保存"
 
 End Sub

代码注释写的很详细了，流程也不复杂。如果谁有更优化的方法请多指教。