根据名称新增工作表

阿煮

疑惑是第一次set sht为sheet("大熊")，不存在这个工作表，于是报错，新增工作表。表单名就叫做大熊.然后执行下一行。set sht为sheet("大熊"),我理解是已经有这个表，就不会保存。If err then后面的新增工作表就不会执行。但是运行了F8。发现程序就继续运行下去。执行新增了工作表。但是工作表名字不会更改。所以想知道，是哪里理解的不对。谢谢~刚入门,求大神指点。

陆离Lowry

Err是对象，你得用Err.number去判断

gwjkkkkk

Sub TEST()
  Dim arr, i&
  Application.DisplayAlerts = False
  arr = [A1].CurrentRegion
  For i = 1 To UBound(arr)
    If bIsWorksheetExist(CStr(arr(i, 1))) Then Sheets(CStr(arr(i, 1))).Delete
    Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    wks.Name = arr(i, 1)
  Next i
  Application.DisplayAlerts = True
End Sub
Public Function bIsWorksheetExist(wksName As String) As Boolean
    On Error Resume Next
    bIsWorksheetExist = Sheets(wksName).Name = wksName
End Function

gwjkkkkk

请参考附件。。。

feilanga

1. Sub 新增工作表()
   
2.     arr = Sheet1.Range("A1").CurrentRegion.Columns(1)
   
3.     Application.ScreenUpdating = False '//关闭屏幕刷新
   
4.     Application.DisplayAlerts = False '//关闭系统提示
   
5.     Dim sht As Worksheet
   
6.     For Each sht In Worksheets
   
7.         If sht.Name <> "目录" Then sht.Delete
   
8.     Next
   
9.     For i = 2 To UBound(arr)
   
10.         表名 = arr(i, 1)
    
11.         If Not 表名是否存在(表名) Then
    
12.             Worksheets.Add after:=Sheets(Sheets.Count)
    
13.             ActiveSheet.Name = 表名
    
14.         End If
    
15.     Next
    
16.     Application.ScreenUpdating = True '//恢复屏幕刷新
    
17.     Application.DisplayAlerts = True '//恢复系统提示
    
18. End Sub
    
19. Function 表名是否存在(表名称)
    
20.     On Error Resume Next
    
21.     s = Sheets(表名称).Name
    
22.     If Err.Number = 0 Then
    
23.         表名是否存在 = True
    
24.     Else
    
25.         表名是否存在 = False
    
26.     End If
    
27. End Function

复制代码

阿煮

gwjkkkkk 发表于 2022-11-19 21:57
请参考附件。。。

谢谢，今天没有分数了。先收藏。我是小白。重新写了一个。也不知道行不行。但是测试下拉还好。这个附件我先收藏。
Sub 跳过重复新建工作表()
    Dim r As Integer, sht As Worksheet
   
    For r = 2 To Worksheets("数据").Cells(Rows.Count, 1).End(xlUp).Row
        
        For Each sht In Worksheets
            If sht.Name = Worksheets("数据").Cells(r, "A").Value Then
                GoTo 找到了
            End If
        Next sht
        
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Worksheets("数据").Cells(r, "A")

找到了:
   
    Next r
   
End Sub

阿煮

陆离Lowry 发表于 2022-11-19 21:27
Err是对象，你得用Err.number去判断

加了一句err.clear好像就可以了。神奇。但是还是半知半解。我去百度下

阿煮

陆离Lowry 发表于 2022-11-19 21:27
Err是对象，你得用Err.number去判断

为什么必须要err.clear呀。好像不写和写就差很多