[已解决]求助，模版新建工作表，并自动递增编号规避4\7不吉利数字

zhaowei239

zjcat35 在一个帖子里这么写了一个宏.效果很不错.但是不能规避 4 这种不吉利数字.我主要是做会员,不想让客户用这种编号数字.
求大神加工一下,看能不能不要 个别的数字.在这先谢过了.谢谢!!!
Sub 新建()
    Application.ScreenUpdating = False
    Dim sh As Worksheet
    With Worksheets("模板")
        .Range("j2").NumberFormatLocal = "000000"
        .Copy after:=Sheets(Sheets.Count)
        Set sh = ActiveSheet
        sh.Range("j2") = Sheets.Count - 2
        sh.Name = sh.Range("j2").Text
        sh.Visible = True
    End With
    Sheets("主页").Select
    Application.ScreenUpdating = True
End Sub

最佳答案

月排行榜 / 总排行榜

lisachen

2013-8-22 15:41

zhaowei239 发表于 2013-8-22 15:35
If VBA.Right(Sheets(Sheets.Count - 1).Name + 1, 1) = "4" Then  这句提示错误信息....还是谢谢您

没错呀？！ book1.rar (14.12 KB, 下载次数: 16)

2013-8-22 15:41 上传

点击文件名下载附件

跳转到最佳答案楼层

zhaowei239

Sub 新建()
    Application.ScreenUpdating = False
    Dim sh As Worksheet
    With Worksheets("模板")
        .Range("d1").NumberFormatLocal = "a"
        If  a = 4 Then
        .Copy after:=Sheets(Sheets.Count) + 1
        esle
        .Copy after:=Sheets(Sheets.Count)
        End If
        Set sh = ActiveSheet
        sh.Range("d1") = Sheets.Count - 2
        sh.Name = sh.Range("d1").Text
        sh.Visible = True
    End With
    Sheets("主页").Select
    Application.ScreenUpdating = True
End Sub


我自己加工了.但是不能用..... if esle 在 宏编程里面的条件怎么写啊?????

继续求高人.!!!

lisachen

1. Sub 新建()
   
2.     Application.ScreenUpdating = False
   
3.     Dim sh As Worksheet
   
4.     With Worksheets("模板")
   
5.         .Range("j2").NumberFormatLocal = "000000"
   
6.         .Copy after:=Sheets(Sheets.Count)
   
7.         Set sh = ActiveSheet
   
8.         If VBA.Right(Sheets(Sheets.Count - 1).Name + 1, 1) = "4" Then
   
9.         sh.Range("j2") = Sheets(Sheets.Count - 1).Name + 2
   
10.         Else
    
11.         sh.Range("j2") = Sheets(Sheets.Count - 1).Name + 1
    
12.         End If
    
13.         sh.Name = sh.Range("j2").Text
    
14.     End With
    
15.     Sheets("主页").Select
    
16.     Application.ScreenUpdating = True
    
17. End Sub
    

复制代码

zhaowei239

lisachen 发表于 2013-8-22 15:07

If VBA.Right(Sheets(Sheets.Count - 1).Name + 1, 1) = "4" Then  这句提示错误信息....还是谢谢您

lisachen

zhaowei239 发表于 2013-8-22 15:35
If VBA.Right(Sheets(Sheets.Count - 1).Name + 1, 1) = "4" Then  这句提示错误信息....还是谢谢您

没错呀？！ book1.rar (14.12 KB, 下载次数: 16)

2013-8-22 15:41 上传

点击文件名下载附件

zhaowei239

lisachen 发表于 2013-8-22 15:41
没错呀？！

厉害!!!!大牛了.   谢谢您~~~   

lisachen

zhaowei239 发表于 2013-8-22 15:35
If VBA.Right(Sheets(Sheets.Count - 1).Name + 1, 1) = "4" Then  这句提示错误信息....还是谢谢您

我知道了 你是第一个表都删除后会出现这个问题
这个可以解决

1. Sub 新建()
   
2.     Application.ScreenUpdating = False
   
3.     Dim sh As Worksheet
   
4.     With Worksheets("模板")
   
5.         .Range("j2").NumberFormatLocal = "000000"
   
6.         .Copy after:=Sheets(Sheets.Count)
   
7.         Set sh = ActiveSheet
   
8.         
   
9.         If Sheets(Sheets.Count - 1).Name = "模板" Then
   
10.         sh.Range("j2") = 1
    
11.         Else
    
12.         If VBA.Right(Sheets(Sheets.Count - 1).Name + 1, 1) = "4" Then
    
13.         sh.Range("j2") = Sheets(Sheets.Count - 1).Name + 2
    
14.         Else
    
15.         sh.Range("j2") = Sheets(Sheets.Count - 1).Name + 1
    
16.         End If
    
17.         End If
    
18.         sh.Name = sh.Range("j2").Text
    
19.     End With
    
20.     Sheets("主页").Select
    
21.     Application.ScreenUpdating = True
    
22. End Sub

复制代码

爱疯

Sub 新建()
    Dim n%, x%

    n = Sheets.Count
    If n = 2 Then
        x = 1
    Else
        x = Sheets(n).Name + 1
        If Right(x, 1) = 4 Or Right(x, 1) = 7 Then x = x + 1
    End If

    Application.ScreenUpdating = False
    Worksheets("模板").Copy after:=Sheets(n)
    With ActiveSheet
        .Range("j2") = x
        ActiveSheet.Name = .Range("j2").Text
    End With
    Sheets(1).Select
End Sub

zhaowei239

Sub 新建()
    Application.ScreenUpdating = False
    Dim sh As Worksheet, x As Integer, k, str
    With Worksheets("模板")
        .Range("j2").NumberFormatLocal = "000000"
        .Copy after:=Sheets(Sheets.Count)
        Set sh = ActiveSheet
        x = Sheets.Count
        If x = 3 Then
            str = 1
            Else: str = VBA.Right(Sheets(x - 1).Name, 1)
        End If
        k = str * 1
        If k <> 3 Then
            sh.Range("j2") = Sheets(x - 1).Range("j2") + 1
            Else:
                  sh.Range("j2") = Sheets(x - 1).Range("j2") + 2
        End If
        sh.Name = sh.Range("j2").Text
    End With
        sh.Name = sh.Range("j2").Text
        Sheets("主页").Select
    Application.ScreenUpdating = True
End Sub
我再上传以为大神 的方法，同样解决问题了。

zhaowei239

最后再谢谢大家。非常感谢！！！