Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1788|回复: 2

[VBA] VBA按C列班级批量新建工作表 解决第二次单击不会出错

[复制链接]
发表于 2017-1-14 19:26 | 显示全部楼层 |阅读模式
VBA按C列班级批量新建工作表   解决第二次单击不会出错

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-1-14 19:41 | 显示全部楼层
本帖最后由 dsmch 于 2017-1-14 19:56 编辑
  1. Sub Macro1()
  2. Application.ScreenUpdating = False
  3. Application.DisplayAlerts = False
  4. For Each sh In Sheets
  5.     If sh.Name <> "成绩表" Then sh.Delete
  6. Next
  7. '原代码
  8. Application.DisplayAlerts = True
  9. Application.ScreenUpdating = True
  10. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
laoau138 + 3 来学习

查看全部评分

回复

使用道具 举报

发表于 2017-1-14 21:53 | 显示全部楼层
本帖最后由 乐乐2006201506 于 2017-1-14 22:07 编辑

谢谢dsmch大师,我被这个问题困惑好长时间了。没弄懂您2楼的通用代码,自己网上查找,终于写出来了,回过头来一看,原来大师早已解决了,看来VBA水平得好好提升了(近段时间还沾沾自喜自己的进步,今天一看,还差得远着了,不会灵活运用,这就是我这个伸手党的悲哀,但令人高兴的是有很多热心的大师)。
Sub ShtAdd1()
    MsgBox "下面将根据C列的班级名新建不同的工作表。"
Application.DisplayAlerts = False
    Dim i As Integer, sh As Worksheet, sht As Worksheet
    i = 2                                  '第一条记录的行号为2
    Set sht = Worksheets("成绩表")
    Do While sht.Cells(i, "C") <> ""       '定义循环条件
        For Each sh In Worksheets
            If sh.Name = sht.Cells(i, "C").Value Then Exit Sub
        Next
        Worksheets.Add after:=Worksheets(Worksheets.Count)      '在所有工作表后插入新工作表
            ActiveSheet.Name = sht.Cells(i, "C").Value             '更改工作表的标签名称
        i = i + 1                         '行号增加1
    Loop
    sht.Select
Application.DisplayAlerts = True
End Sub
希望对你有用。也谢谢你的这个帖子,让我终于解决了好长时间的一个困惑。


Sub Macro1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim i As Integer, sh As Worksheet, sht As Worksheet
For Each sh In Sheets
    If sh.Name <> "成绩表" Then sh.Delete
Next
'原代码
    MsgBox "下面将根据C列的班级名新建不同的工作表。"
    i = 2                                  '第一条记录的行号为2
    Set sht = Worksheets("成绩表")
    Do While sht.Cells(i, "C") <> ""       '定义循环条件
        Worksheets.Add after:=Worksheets(Worksheets.Count)      '在所有工作表后插入新工作表
        ActiveSheet.Name = sht.Cells(i, "C").Value             '更改工作表的标签名称
        i = i + 1                         '行号增加1
    Loop
    sht.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub



上面两种方法殊途同归,各有优劣。


不知道有没有其他方法?

评分

参与人数 1 +3 收起 理由
laoau138 + 3 来学习

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 03:25 , Processed in 0.527431 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表