批量增加工作表并命名，求修改（精简代码），谢谢！

pp9257

其实我想要的效果是 一次增加一个工作表。  附件里面的代码是批量增加的。

另外我是在inputbox里面输入表格名称 ，一个一个增加，并重新命名。

现有的代码已经达到目的，但是拼凑起来的始终不完美，求高手修改……

见附件详细说明。谢谢！ 批量加表格1.rar (22.73 KB, 下载次数: 133)

2012-2-5 19:44 上传

点击文件名下载附件

KCFONG

see if help you,
No needed to be so complex

Sub wode啊()
If Range("a1") = "" Then
   MsgBox "你还没有输入新增构件表名称！", 64, "提示"
   Exit Sub
Else
        Sheets("样表").Copy , Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets("表头").Range("a1")
End If
End Sub

lhdcxz

Sub wode啊() '下面是拼凑起来的代码，反正是能用
Application.ScreenUpdating = False
    Dim X As Worksheet
    n = InputBox("写入表格名称", "新增构件表")
    On Error Resume Next
    If X Is Nothing Then
        Sheets("样表").Copy , Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = n
    End If
    Set X = Nothing
    Application.ScreenUpdating = True
End Sub

pp9257

KCFONG 发表于 2012-2-5 19:59
see if help you,
No needed to be so complex

KFC可能理解有误，我就是不需要把inputbox的内容输入到单元格内。

3楼的代码就是这个意思，马上试试，谢谢~

pp9257

ok了。谢谢。
如果样表本身是隐藏的，复制的表格也就隐藏了。
因此我加了一句Sheets(Sheets.Count).Visible = 1   搞定。

pp9257

lhdcxz 发表于 2012-2-5 20:01
Sub wode啊() '下面是拼凑起来的代码，反正是能用
Application.ScreenUpdating = False
    Dim X As Wor ...

试了一下，还是有个问题，如果inputbox 输入的 新增表格名称与 已经存在的表格名称相同，还是新建了表格！

如何加代码避免这个问题呢？

还有非法符号、字符长度等问题

pp9257

下面是罗刚君老师在别的帖子的相关代码，3楼的朋友可否借鉴一下，帮助我解决一下，谢谢
Sub test()
    Dim aa As String
    On Error Resume Next
    aa = InputBox("sheet命名", "初步分析")
    If Len(aa) > 0 Then
        Sheets.Add , Sheets(Sheets.Count)
        ActiveSheet.Name = aa
        If Err <> 0 Then
            Application.DisplayAlerts = False
            ActiveSheet.Delete
            Application.DisplayAlerts = True
            MsgBox "请重新录入"
        End If
    End If
End Sub
这样会更好
1.新表放最后
2.如果没录入名字，则不生成新表，这是防错的必要
3.如果录入特殊字符，例如“\\”，由于它不能作为工作表名字，那么生成的新表会命名不成功，所以要删除未命名的表
4.工作表名有长度限制，所以当超过上限时同样会命名不成功，那么需要再次防错，将未命名的表删除

代码尽量考虑全面一点

以上是罗老师的原话，一字不差的copy来了 呵呵

pp9257

1. 
   
2. Sub wode啊2() '下面是拼凑起来的代码，反正是能用
   
3. Application.ScreenUpdating = False
   
4.     Dim X As Worksheet
   
5.     n = InputBox("写入表格名称", "新增构件表")
   
6.     On Error Resume Next
   
7.     If X Is Nothing And Len(n) > 0 Then
   
8.         Sheets("样表").Copy , Sheets(Sheets.Count)
   
9.         Sheets(Sheets.Count).Name = n
   
10.         Sheets(Sheets.Count).Visible = 1
    
11.     Else
    
12.     MsgBox "没有输入新增表名称！", 64, "提示"
    
13.     End If
    
14.     If Err <> 0 Then
    
15.             Application.DisplayAlerts = False
    
16.             ActiveSheet.Delete
    
17.             Application.DisplayAlerts = True
    
18.             MsgBox "表名重复或含有非法字符！", 64, "提示"
    
19.     End If
    
20.    
    
21.     Set X = Nothing
    
22.     Application.ScreenUpdating = True
    
23. End Sub

复制代码

嘿嘿，这样融合在一起了。 不知道还有什么漏洞。
还加了两个消息框。。。

风云际会6

学习了，都是好样的

pp9257

弱弱的再问一句，代码里面空行比较多的话，是否对代码速度有影响？