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

jessiekangjx · 发表于 2019-12-9 22:03

第十节课的作业就不会了。。

lisachen · 发表于 2019-12-9 22:51

时间草原 · 发表于 2019-12-12 06:39

phoebe_teng · 发表于 2019-12-13 22:24

谢谢

gy92_cool · 发表于 2019-12-18 20:16

保持学习

学海无涯苦作舟 · 发表于 2019-12-29 21:52

[hide]
Sub 日报表格式生成()
Dim x As Integer
Dim sh As Worksheet
Sheets("日报表模板").Visible = True
Sheets("日报表模板").Copy after:=Sheets(Sheets.Count)
If Sheets.Count = 3 Then
x = 1
Else
x = Sheets.Count - 2
End If
Set sh = ActiveSheet
sh.Name = x & "日报表"
Sheets("日报表模板").Visible = False
Sheets("第1题").Select
MsgBox x & "日报表已生成"
End Sub
Sub 另存报表()
Dim x As Integer
Dim sh As Workbook
If Sheets.Count < 3 Then
Exit Sub
Else
For x = 1 To Sheets.Count - 2 Step 1
Sheets(x & "日报表").Copy
Set sh = ActiveWorkbook
sh.SaveAs ThisWorkbook.Path & "" & x & "日报表.xlsx"
sh.Close True
Next x
MsgBox x - 1 & "份报表已生成"
End If
End Sub
[/hide]

复制代码

springriver · 发表于 2020-1-2 18:29

Sub 日报表格式生成()
Dim wht As Worksheet '定义变量，类型为worksheet
Dim i As Integer '定义变量，类型为integer
Dim num As Integer '定义变量，类型为integer
num = 1 '设置默认日期天数为1
Sheets("日报表模板").Visible = True '将日报表模板隐藏取消
Sheets("日报表模板").Copy after:=Sheets(Sheets.Count) '在工作表最后一个后面复制一个新表
Set wht = ActiveSheet '将新表引用名只想wht
For i = 1 To Sheets.Count '遍历所有表
      If (num & "日报表") = Sheets(i).Name Then '如果工作表名有1日报表则将日期加1
         num = num + 1
      End If
Next i

wht.Name = num & "日报表" '修改新表名
Sheets("日报表模板").Visible = False '隐藏日报表模板
Worksheets("第1题").Select '返回第1题的工作表

End Sub
Sub 另存报表()
Dim wk As Workbook
Dim i As Integer
Dim num As Integer

num = 1
For i = 1 To Sheets.Count
      If (num & "日报表") = Sheets(i).Name Then

         Sheets(i).Copy
         Set wk = ActiveWorkbook

         wk.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Sheets(i).Name & ".xls"
         wk.Close
         num = num + 1
      End If
      'num = num + 1
Next i

End Sub

daijinlong · 发表于 2020-1-5 12:34

想看看答案

liujia5863 · 发表于 2020-1-6 14:16

11111111111111111111111111

huazhixi · 发表于 2020-1-6 18:08

看看

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