[發問] 請問如何利用vba刪除活頁簿中的工作表?

棋語鳥鳴

如果我的活頁簿中有n個工作表
我只想保留sheet1 & sheet2
其餘的從 sheet3開始包含以上的工作表全部刪掉!
請問指令要如何下??

GBKEE

回復 1# 棋語鳥鳴

1. Sub Ex()
   
2.     Dim i As Integer
   
3.     Application.DisplayAlerts = False
   
4.     For i = Sheets.Count To 3 Step -1
   
5.         Sheets(i).Delete
   
6.     Next
   
7.     Application.DisplayAlerts = True
   
8. End Sub

複製代碼

棋語鳥鳴

回復 2# GBKEE


    原來是這樣寫阿~我一直想不通~G大謝謝阿~每次都麻煩您~真是不好意思!!

waterful.tw

請問GBKEE版大，如果我工作表都有特殊的命名方式（日期+投入量），可否以陣列方式將之前新增的檔案刪除，下面是我的程式碼：
PS.我知道不能用dir來指定工作頁，不過目前我還沒想到其他方式

1. Sub 投入量()
   
2. 
   
3.     Set MyBook = ThisWorkbook
   
4.     Set MySht = MyBook.Sheets("報表")
   
5.     MyPath = MyBook.Path & "\投入量\"
   
6. 
   
7.     '刪除工作頁
   
8.     Dim FindSht( ) As String
   
9.     FindSht( ) = Dir(MyBook.Sheet("*投入量"))
   
10.     Do While FindSht( ) <> ""
    
11.         FindSht( ).Delete
    
12.     Loop
    
13. 
    
14.     '匯入資料
    
15.     Dim str(1), FindFile(1) As String, WbDate(1) As Date
    
16.     For i = 3 To 95
    
17.         If i Mod 3 = 0 Then
    
18.             If MySht.Cells(i, 1).Value <> "" Then
    
19.                 WbDate(0) = MySht.Cells(i, 1).Value
    
20.                 WbDate(1) = MySht.Cells(i, 1).Value + 1
    
21.                 str(0) = Format(WbDate(0), "mmddyyyy")
    
22.                 str(1) = Format(WbDate(1), "mmddyyyy")
    
23. 
    
24.                 FindFile(0) = Dir(MyPath & "d_ic1_" & str(0) & "_0200.xls")                 '開date(0)檔案
    
25.                 If FindFile(0) <> "" Then
    
26.                     Workbooks.Open MyPath & FindFile(0)
    
27. 
    
28.                     Windows("d_ic1_" & str(0) & "_0200.xls").Activate
    
29.                     Range("C35:F35").Select
    
30.                     Application.CutCopyMode = False
    
31.                     Selection.Copy
    
32.                
    
33.                     Windows("尖離峰發電及焚化量統計.xls").Activate
    
34.                     Worksheets.Add
    
35.                     ActiveSheet.Name = Mid(str(0), 1, 4) + "投入量"
    
36.                     Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
37.                     :=False, Transpose:=False
    
38. 
    
39.                     Workbooks(FindFile(0)).Close SaveChanges:=False
    
40.                 Else
    
41.                     MsgBox "找不到檔案: " & "d_ic1_" & str(0) & "_0200.xls", 0 + 48, ">>提示訊息": Exit Sub 'Exit For會產生next無for錯誤!!
    
42.                     Application.ScreenUpdating = False
    
43.                 End If
    
44.         
    
45.                 FindFile(1) = Dir(MyPath & "d_ic1_" & str(1) & "_0200.xls")                 '開date(1)檔案
    
46.                 If FindFile(1) <> "" Then
    
47.                     Workbooks.Open MyPath & FindFile(1)
    
48. 
    
49.                     Windows("d_ic1_" & str(1) & "_0200.xls").Activate
    
50.                     Range("C12:F34").Select
    
51.                     Application.CutCopyMode = False
    
52.                     Selection.Copy
    
53. 
    
54.                     Windows("尖離峰發電及焚化量統計.xls").Activate
    
55.                     Sheets(Mid(str(0), 1, 4) + "投入量").Activate
    
56.                     Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
57.                     :=False, Transpose:=False
    
58. 
    
59.                     Range("A1").FormulaR1C1 = "Hour"
    
60.                     Range("A2").FormulaR1C1 = "00:00"
    
61.                     Range("A3").FormulaR1C1 = "01:00"
    
62.                     Range("A2:A3").Select
    
63.                     Selection.AutoFill Destination:=Range("A2:A25")
    
64.    
    
65.                     Range("B1").FormulaR1C1 = "#1爐投入量"
    
66.                     Range("C1").FormulaR1C1 = "#2爐投入量"
    
67.                     Range("D1").FormulaR1C1 = "#3爐投入量"
    
68.                     Range("E1").FormulaR1C1 = "#4爐投入量"
    
69.                     
    
70.                     Range("G1").FormulaR1C1 = "值別"
    
71.                     Range("G2").FormulaR1C1 = "1"
    
72.                     Range("G3").FormulaR1C1 = "2"
    
73.                     Range("G4").FormulaR1C1 = "3"
    
74.                     Range("H1").FormulaR1C1 = "#1爐投入量"
    
75.                     Range("H2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
    
76.                     Range("H3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
    
77.                     Range("H4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
    
78.                     Range("I1").FormulaR1C1 = "#2爐投入量"
    
79.                     Range("I2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
    
80.                     Range("I3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
    
81.                     Range("I4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
    
82.                     Range("J1").FormulaR1C1 = "#3爐投入量"
    
83.                     Range("J2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
    
84.                     Range("J3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
    
85.                     Range("J4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
    
86.                     Range("K1").FormulaR1C1 = "#4爐投入量"
    
87.                     Range("K2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
    
88.                     Range("K3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
    
89.                     Range("K4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
    
90.                     Range("L1").FormulaR1C1 = "附註"
    
91.                     Range("L2").FormulaR1C1 = "23:00~08:00"
    
92.                     Range("L3").FormulaR1C1 = "08:00~15:00"
    
93.                     Range("L4").FormulaR1C1 = "15:00~23:00"
    
94.                     
    
95.                     Workbooks(FindFile(1)).Close SaveChanges:=False
    
96.                 Else
    
97.                     MsgBox "找不到檔案: " & "d_ic1_" & str(1) & "_0200.xls", 0 + 48, ">>提示訊息": Exit Sub
    
98.                     Application.ScreenUpdating = False
    
99.                 End If
    
100.             End If
     
101.         End If
     
102.     Next
     
103. End Sub

複製代碼

GBKEE

回復 4# waterful.tw
是這樣碼?

1. Option Explicit
   
2. Sub 投入量()
   
3.     Dim MyBook As Workbook, MySht As Worksheet, MyPath As String
   
4.     Set MyBook = ThisWorkbook
   
5.     Set MySht = MyBook.Sheets("報表")
   
6.     MyPath = MyBook.Path & "\投入量\"
   
7.     '刪除工作頁 ( 檔案 )
   
8.     Kill MyPath & "*投入量*"   '刪除檔名中有 "投入量" 字串 的檔案
   
9.    ' Kill "d:\*.txt"                 '刪除所有txt檔,的檔案
   
10. End Sub

複製代碼

waterful.tw

Sorry版大，我描述的不夠清楚，是刪除產生的sheets("*投入量")，附上我的檔案做參考，感謝！ 尖離峰發電及焚化量統計.rar (92.58 KB)

下載次數: 5

2013-5-8 11:36

GBKEE

回復 6# waterful.tw
那是這樣!!

1. Sub 投入量()
   
2.     Dim MyBook As Workbook, sh As Worksheet
   
3.     Set MyBook = ThisWorkbook
   
4.     Application.DisplayAlerts = False  '停止系統的警示
   
5.     For Each sh In MyBook.Sheets
   
6.         If sh.Name Like "*投入量" Then sh.Delete
   
7.     Next
   
8.     Application.DisplayAlerts = True   '恢復系統的警示
   
9. End Sub

複製代碼

waterful.tw

回復 7# GBKEE
感謝GBKEE版大，問題已解決，我還沒想到可以用For Each...Next迴圈叫WB裡面的所有sheets，版大果然厲害！