Board logo

標題: [發問] 請問如何利用vba刪除活頁簿中的工作表? [打印本頁]
作者: 棋語鳥鳴    時間: 2011-9-25 20:04     標題: 請問如何利用vba刪除活頁簿中的工作表?

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

回復 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
複製代碼
作者: 棋語鳥鳴    時間: 2011-9-26 21:14

回復 2# GBKEE


    原來是這樣寫阿~我一直想不通~G大謝謝阿~每次都麻煩您~真是不好意思!!
作者: waterful.tw    時間: 2013-5-8 10:34

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

  3.     Set MyBook = ThisWorkbook
  4.     Set MySht = MyBook.Sheets("報表")
  5.     MyPath = MyBook.Path & "\投入量\"

  7.     '刪除工作頁
  8.     Dim FindSht( ) As String
  9.     FindSht( ) = Dir(MyBook.Sheet("*投入量"))
  10.     Do While FindSht( ) <> ""
  11.         FindSht( ).Delete
  12.     Loop

  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")

  24.                 FindFile(0) = Dir(MyPath & "d_ic1_" & str(0) & "_0200.xls")                 '開date(0)檔案
  25.                 If FindFile(0) <> "" Then
  26.                     Workbooks.Open MyPath & FindFile(0)

  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

  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)

  49.                     Windows("d_ic1_" & str(1) & "_0200.xls").Activate
  50.                     Range("C12:F34").Select
  51.                     Application.CutCopyMode = False
  52.                     Selection.Copy

  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

  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    時間: 2013-5-8 10:56

回復 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    時間: 2013-5-8 11:37     標題: RE: 請問如何利用vba刪除活頁簿中的工作表?

Sorry版大，我描述的不夠清楚，是刪除產生的sheets("*投入量")，附上我的檔案做參考，感謝！[attach]14920[/attach][attach]14920[/attach]
作者: GBKEE    時間: 2013-5-8 12:36

回復 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    時間: 2013-5-8 14:04

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)