VBA80集第10集练习上交专贴（正确答案奖励20金币）

tianmm · 发表于 2022-7-9 23:11

学习

ginhom7 · 发表于 2022-8-20 22:44

厉害

思霖 · 发表于 2022-8-23 11:39

学习

risona · 发表于 2022-8-30 20:26

本帖最后由 risona 于 2022-8-31 11:07 编辑

第一题：插入表格至最后一张并重命名
Sub job1()
Dim x As Worksheet
Worksheets(1).Copy after:=Worksheets(Worksheets.Count)
Set x = ActiveSheet
x.Name = Worksheets.Count & "日报表"
x.Visible = False
End Sub
第二题：将所有表另存为当下文件路径的工作簿，以表名命名工作簿名
Sub job2()
Dim x As Workbook    '工作簿
Dim ws As Worksheet       '工作表
For Each ws In Worksheets
ws.Copy       '复制工作表到新工作簿
Set x = ActiveWorkbook '将新工作簿放入x工作簿
x.SaveAs ThisWorkbook.Path & ws.Name    '保存x工作簿为当前路径，名字为表的名字
Next
End Sub
问题：重命名的工作簿名包含了路径名，不是我想要的。

kingmissh · 发表于 2022-9-1 10:28

VBA80集第10集练习

kameric · 发表于 2022-9-6 11:35

本帖最后由 kameric 于 2022-9-9 11:25 编辑

参考学习前辈的经验和思路，优化了自己写的代码

[hide] Sub 日报表格式生成()
Dim mb As Worksheet '声明模板的工作表对象变量mb
Dim rb As Worksheet '声明日报的工作表对象变量rb
Dim x As Integer '声明循环变量x
Dim TSName As String '声明临时表格名变量TSName
Dim NDay As Integer '声明当前日期的天数变量
TSName = Sheets(Sheets.Count).Name '复制模板前把目前最后一个表格的名称赋值给变量TSName
For x = 1 To Sheets.Count '在当前工作表数量循环查找
If Sheets(x).Name = "日报表模板" Then '按顺序逐个判断工作表名称是否有模板
Set mb = Sheets(x) '找到模板即赋值给变量mb
With mb
.Visible = xlSheetVisible '显示模板(xlSheetVisible = true)
.Copy after:=Sheets(Sheets.Count) '复制模板至最后
.Visible = xlSheetHidden '隐藏模板（xlSheetHidden = false，xlSheetVeryHidden不可手动取消隐藏）
End With
Set rb = ActiveSheet '把新复制的模板复制给变量rb
Exit For '找到模板跳出for循环
End If
Next x
NDay = Format(Now, "d") '用Format+Now函数组合，将当前日期的天数赋值给变量NDay
If Right(TSName, 2) <> "日报" Then '判断TSName工作表名称变量的最后2个字符是否不等于“日报”
rb.Name = 1 & "日报" '逻辑是，新建模板工作表改名为1日报表
ElseIf Left(TSName, Len(TSName) - 2) + 1 > NDay Then '添加第二个判断条件，新建日报是否大于当前日期天数
Application.DisplayAlerts = False '逻辑是，清楚警报+删除新建模板
rb.Delete
Application.DisplayAlerts = True
Else
rb.Name = Left(TSName, Len(TSName) - 2) + 1 & "日报" '逻辑否，新建模板工作表改名为“+1”日报
End If
End Sub
Sub 另存报表()
Dim Nwb As Workbook '声明复制新建工作簿
Dim x As Integer '声明循环变量x
Dim TSheetName As String '声明工作表名称变量TSheetName
Dim StartNum As String, EndNum As String '声明存储文件名开始和结束号码变量
For x = Sheets.Count To 1 Step -1 '工作簿内所有工作表按倒序循环
TSheetName = Sheets(x).Name '将每个工作表的名称赋值给变量TSheerName
If Right(TSheetName, 2) = "日报" And Nwb Is Nothing Then '工作表名为“日报”+ Nwb变量未赋值两个条件叠加判断，【对象变量 + is + nothing】判断对象变量是否赋值
EndNum = Left(TSheetName, Len(TSheetName) - 2) '将第一个（即最后一天）日报的天数赋值给EndNum变量
Sheets(x).Copy '逻辑是，将“日报”另存副本复制至新建工作簿
Set Nwb = ActiveWorkbook '将新建工作簿对象赋值给变量Nwb
ThisWorkbook.Activate '焦点重新切换到原工作簿，否则循环将出差
ElseIf Right(TSheetName, 2) = "日报" Then '判断工作表名为“日报”
StartNum = Left(TSheetName, Len(TSheetName) - 2) '将最后一个日报的天数赋值给StartNum变量
Sheets(x).Copy Before:=Nwb.Worksheets(1) '逻辑是，将剩余的“日报”全部另存副本复制至刚刚新建的工作簿内
ThisWorkbook.Activate '工作簿焦点切换
End If
Next x
With Nwb
.Activate '结束复制后，焦点切换新建工作簿
.SaveAs ThisWorkbook.Path & "/" & StartNum & "-" & EndNum & "日报.xls" '新建工作簿另存为同一个路径下，文件名为“开始-结束日报”
.Close True '关闭新建工作簿
End With
End Sub
[/hide]

复制代码

iopan2023 · 发表于 2022-9-24 16:48

谢谢谢谢1111

Laopiao2000 · 发表于 2022-9-30 09:56

感谢分享

phhao007 · 发表于 2022-12-3 14:13

liuts 发表于 2011-7-2 17:22
**** 本内容被作者隐藏 ****

没毛病

xx1096 · 发表于 2022-12-4 06:36

学习

		自动登录	找回密码
密码			注册