使用VBA设计通用的一键生成任意月份值班表
2023-12-13 16:33:59
##使用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
代码注释写的很详细了,流程也不复杂。如果谁有更优化的方法请多指教。
文章来源:https://blog.csdn.net/weixin_31707323/article/details/134972757
本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。 如若内容造成侵权/违法违规/事实不符,请联系我的编程经验分享网邮箱:veading@qq.com进行投诉反馈,一经查实,立即删除!
本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。 如若内容造成侵权/违法违规/事实不符,请联系我的编程经验分享网邮箱:veading@qq.com进行投诉反馈,一经查实,立即删除!