字典方法添加Sheet

ning84

1. Sub deldel()
   
2.     Dim Sht As Worksheet
   
3.         Set Sht = DictAddSheet(ThisWorkbook, "A1")
   
4.         Debug.Print Sht.Name
   
5.         Set Sht = ForEachAddSheet(ThisWorkbook, "A2")
   
6.         Debug.Print Sht.Name
   
7. End Sub
   
8. 
   
9. Function DictAddSheet(Wk As Workbook, Str)
   
10.    Dim Dict As Dictionary
    
11.        Set Dict = New Dictionary
    
12.    Dim Sht As Worksheet
    
13.      For Each Sht In Wk.Sheets
    
14.          Dict(Sht.Name) = ""
    
15.      Next Sht
    
16.      If Not Dict.Exists(Str) Then
    
17.           Set AddSheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
    
18.           AddSheet.Name = Str
    
19.      Else
    
20.           Set DictAddSheet = Sheets(Str)
    
21.      End If
    
22. End Function
    
23. 
    
24. Function ForEachAddSheet(Wk As Workbook, Str)
    
25.    Dim Sht As Worksheet
    
26.      For Each Sht In Wk.Sheets
    
27.         If Sht.Name = Str Then
    
28.             Set ForEachAddSheet = Sht
    
29.             Exit Function
    
30.         End If
    
31.      Next Sht
    
32.      
    
33.      Set ForEachAddSheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
    
34.      ForEachAddSheet.Name = Str
    
35. End Function
    

复制代码

ynzsvt

1. Sub deldel()
   
2. Dim Sht As Worksheet
   
3. Set Sht = DictAddSheet(ThisWorkbook, "A1")
   
4. Debug.Print Sht.Name
   
5. Set Sht = ForEachAddSheet(ThisWorkbook, "A2")
   
6. Debug.Print Sht.Name
   
7. End Sub
   
8. 
   
9. Function DictAddSheet(Wk As Workbook, Str)
   
10. Dim Dict As Dictionary
    
11. Set Dict = New Dictionary
    
12. Dim Sht As Worksheet
    
13. For Each Sht In Wk.Sheets
    
14.   Dict(Sht.Name) = ""
    
15. Next Sht
    
16. If Not Dict.Exists(Str) Then '用输出的工作表变量名
    
17.   Set DictAddSheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
    
18.   DictAddSheet.Name = Str
    
19. Else
    
20.   Set DictAddSheet = Sheets(Str)
    
21. End If
    
22. End Function
    
23. 
    
24. Function ForEachAddSheet(Wk As Workbook, Str)
    
25. Dim Sht As Worksheet
    
26. For Each Sht In Wk.Sheets
    
27.   If Sht.Name = Str Then
    
28.    Set ForEachAddSheet = Sht
    
29.    Exit Function
    
30.   End If
    
31. Next Sht
    
32. 
    
33. Set ForEachAddSheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
    
34. ForEachAddSheet.Name = Str
    
35. End Function

复制代码

ning84

ynzsvt 发表于 2024-8-24 09:21

学习学习，在学习

1. 
   
2. Function AddSheet(Wk As Workbook, Str)
   
3.    Dim Sht As Worksheet
   
4.      For Each Sht In Wk.Sheets
   
5.         If Sht.Name = Str Then
   
6.             Set AddSheet = Sht
   
7.             Exit Function
   
8.         End If
   
9.      Next Sht
   
10.      
    
11.      Set AddSheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
    
12.      AddSheet.Name = Str
    
13. End Function
    
14. 
    
15. Sub SelectFolderChangeSheet()
    
16.    Dim Sht As Worksheet, Rng As Range, Kk
    
17.    Dim BaseRow
    
18.       
    
19.    Dim Fso As FileSystemObject, oFile As File
    
20.        Set Fso = New FileSystemObject
    
21.    Dim oFolder As Folder
    
22.    Dim Ff As FileDialog
    
23.    Set Ff = Application.FileDialog(msoFileDialogFolderPicker)
    
24.    With Ff
    
25.       .Title = ""
    
26.       .AllowMultiSelect = True
    
27.       .InitialFileName = "F:"
    
28.       .Show
    
29.       Set oFolder = Fso.GetFolder(.SelectedItems(1))
    
30.    End With
    
31.    Debug.Print oFolder.Name
    
32.    Set Sht = AddSheet(ThisWorkbook, oFolder.Name)
    
33.    BaseRow = 10
    
34.    Kk = BaseRow
    
35.    
    
36.    For Each oFile In oFolder.Files
    
37.         Sht.Cells(Kk, "A") = Sht.Cells(Kk, 1).Row - BaseRow + 1
    
38.         
    
39.         Sht.Cells(Kk, "B") = oFile.DateLastModified
    
40.         Sht.Cells(Kk, "C") = oFile.Name
    
41.         Sht.Cells(Kk, "D") = Round(oFile.Size / 1024 ^ 2, 1)
    
42.         'Rng(Kk, 2) = oFile.Path
    
43.         Kk = Kk + 1
    
44.    Next oFile
    
45.    
    
46.    
    
47. End Sub ''

复制代码

taller

ning84

taller 发表于 2024-12-8 09:22

谢谢指点，因为我的代码很短，不愿意用 On Error Resume Next.\直接找到错误点。


但是学习到 Sht iIs nothing 的用法。