vba函数实现

• 循环复制前一个表
• 另存为
• 删除报表
• 日期为报表名称的创建
• 工作表名字统计到第一个表中
• 删除无用表

循环复制前一个表

题目１:

复制“日报表模板”工作表(已隐藏)至本工作簿最后一个位置，复制后的工作表名称为最后的日期天数+1&"报表"的格式。
如：
当前情况下，没有任何一天的日报表，则新复制的工作表名称是“1日报表”，如果再添加时就是1+1=2日报表。如果目前已存在5天的日报表，则复制后的工作表名称应为“6日报表”

注：“日报表模板”工作表复制后要隐藏起来

Sub 日报表格式生成()
Dim msh As Worksheet, shname$ // 创建一个工作表，$表示定义的变量shname的类型为string（字符串型）
Application.ScreenUpdating = False//app.scr语句作用是在表里面数据发生变化后False禁止实时刷新True为默认值表示实时更新数据。
Set msh = Sheets("日报表模板")//设置msh为模板工作表
shname = Sheets(Sheets.Count).Name//定义所有的shname模板名字为前有数字
With msh//对于模板表，设置为可见表，向添加，再隐藏
    .Visible = xlSheetVisible
    .Copy after:=Sheets(Sheets.Count)
    .Visible = xlSheetHidden
End With//结束msh的设置
If shname = msh.Name Or shname = "第1题" Then//如果表的位置在第一个
    ActiveSheet.Name = 1 & "日报表"//输出1日表
Else//否则向左输出天数日表
    ActiveSheet.Name = Left(shname, Len(shname) - 3) + 1 & "日报表"
End If//结束判断
Application.ScreenUpdating = True//刷新可见
End Sub//结束程序

另存为

题目2：
把所有日报表另存为工作簿到本文夹下，工作簿名称为工作表的名称

Sub 另存报表()
Dim i As Integer, mb As Workbook
For i = 3 To Sheets.Count
Sheets(i).Copy
Set mb = ActiveWorkbook
mb.SaveAs Filename:=ThisWorkbook.Path & "/" & Sheets(1).Name & ".xls"
mb.Close True
Next i
End Sub

删除报表

题目3 清除报表

Sub 清除日报表()
    Dim i As Integer
    Dim sh As Worksheet
    For Each sh In Sheets
        If sh.Name Like "*日报表" Then
        Application.DisplayAlerts = False
            sh.Delete
        Application.DisplayAlerts = False
        End If
    Next
End Sub

日期为报表名称的创建

形成一个月报表

Sub mode()
    Dim i As Integer
    For i = 1 To 31
        Sheets(Sheets.Count).Range("e5") = "2020 - 5 -" & i
        Sheet1.Copy after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = "2020 - 5-" & i + 1 
    Next
End Sub


//标准答案
Sub test()
Dim i As Integer

For i = 1 To 31
    Sheet1.Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "5月" & i & "日"
    Sheets(Sheets.Count).Range("e5") = "2020-5-" & i
Next

End Sub

工作表名字统计到第一个表中

将sheet名字统计在第一个表格中
注意定义dim 是worksheet ，后面for each sht in sheets

Sub one()
    '复制一个名字到a1上
    Dim sht As Worksheet
    Dim i As Integer
    For Each sht In Sheets
        For i = 1 To Sheets.Count
            Worksheets(1).Range("a" & i) = Worksheets(i).Name
        Next
    Next
End Sub

删除无用表

注意application函数用于取消弹窗

Sub bushan()
    Application.DisplayAlerts = False//取消弹窗
    Dim sht As Worksheet
    For Each sht In Sheets
        If sht.Name <> "绝不能删" Then
            sht.Delete
            
        End If
    Next
    Application.DisplayAlerts = False
End Sub

标签：Count,vba,End,Sub,excel,日报表,Sheets,Name,多余
来源： https://blog.csdn.net/kyra1997/article/details/107715858