返回列表 上一主題 發帖

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

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

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

回復 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
複製代碼

TOP

回復 2# GBKEE


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

TOP

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

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

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

  11.     '匯入資料
  12.     Dim str(1), FindFile(1) As String, WbDate(1) As Date
  13.     For i = 3 To 95
  14.         If i Mod 3 = 0 Then
  15.             If MySht.Cells(i, 1).Value <> "" Then
  16.                 WbDate(0) = MySht.Cells(i, 1).Value
  17.                 WbDate(1) = MySht.Cells(i, 1).Value + 1
  18.                 str(0) = Format(WbDate(0), "mmddyyyy")
  19.                 str(1) = Format(WbDate(1), "mmddyyyy")

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

  23.                     Windows("d_ic1_" & str(0) & "_0200.xls").Activate
  24.                     Range("C35:F35").Select
  25.                     Application.CutCopyMode = False
  26.                     Selection.Copy
  27.                
  28.                     Windows("尖離峰發電及焚化量統計.xls").Activate
  29.                     Worksheets.Add
  30.                     ActiveSheet.Name = Mid(str(0), 1, 4) + "投入量"
  31.                     Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  32.                     :=False, Transpose:=False

  33.                     Workbooks(FindFile(0)).Close SaveChanges:=False
  34.                 Else
  35.                     MsgBox "找不到檔案: " & "d_ic1_" & str(0) & "_0200.xls", 0 + 48, ">>提示訊息": Exit Sub 'Exit For會產生next無for錯誤!!
  36.                     Application.ScreenUpdating = False
  37.                 End If
  38.         
  39.                 FindFile(1) = Dir(MyPath & "d_ic1_" & str(1) & "_0200.xls")                 '開date(1)檔案
  40.                 If FindFile(1) <> "" Then
  41.                     Workbooks.Open MyPath & FindFile(1)

  42.                     Windows("d_ic1_" & str(1) & "_0200.xls").Activate
  43.                     Range("C12:F34").Select
  44.                     Application.CutCopyMode = False
  45.                     Selection.Copy

  46.                     Windows("尖離峰發電及焚化量統計.xls").Activate
  47.                     Sheets(Mid(str(0), 1, 4) + "投入量").Activate
  48.                     Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  49.                     :=False, Transpose:=False

  50.                     Range("A1").FormulaR1C1 = "Hour"
  51.                     Range("A2").FormulaR1C1 = "00:00"
  52.                     Range("A3").FormulaR1C1 = "01:00"
  53.                     Range("A2:A3").Select
  54.                     Selection.AutoFill Destination:=Range("A2:A25")
  55.    
  56.                     Range("B1").FormulaR1C1 = "#1爐投入量"
  57.                     Range("C1").FormulaR1C1 = "#2爐投入量"
  58.                     Range("D1").FormulaR1C1 = "#3爐投入量"
  59.                     Range("E1").FormulaR1C1 = "#4爐投入量"
  60.                     
  61.                     Range("G1").FormulaR1C1 = "值別"
  62.                     Range("G2").FormulaR1C1 = "1"
  63.                     Range("G3").FormulaR1C1 = "2"
  64.                     Range("G4").FormulaR1C1 = "3"
  65.                     Range("H1").FormulaR1C1 = "#1爐投入量"
  66.                     Range("H2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
  67.                     Range("H3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
  68.                     Range("H4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
  69.                     Range("I1").FormulaR1C1 = "#2爐投入量"
  70.                     Range("I2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
  71.                     Range("I3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
  72.                     Range("I4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
  73.                     Range("J1").FormulaR1C1 = "#3爐投入量"
  74.                     Range("J2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
  75.                     Range("J3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
  76.                     Range("J4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
  77.                     Range("K1").FormulaR1C1 = "#4爐投入量"
  78.                     Range("K2").FormulaR1C1 = "=SUM(RC[-6]:R[8]C[-6])"
  79.                     Range("K3").FormulaR1C1 = "=SUM(R[8]C[-6]:R[14]C[-6])"
  80.                     Range("K4").FormulaR1C1 = "=SUM(R[14]C[-6]:R[21]C[-6])"
  81.                     Range("L1").FormulaR1C1 = "附註"
  82.                     Range("L2").FormulaR1C1 = "23:00~08:00"
  83.                     Range("L3").FormulaR1C1 = "08:00~15:00"
  84.                     Range("L4").FormulaR1C1 = "15:00~23:00"
  85.                     
  86.                     Workbooks(FindFile(1)).Close SaveChanges:=False
  87.                 Else
  88.                     MsgBox "找不到檔案: " & "d_ic1_" & str(1) & "_0200.xls", 0 + 48, ">>提示訊息": Exit Sub
  89.                     Application.ScreenUpdating = False
  90.                 End If
  91.             End If
  92.         End If
  93.     Next
  94. End Sub
複製代碼
waterful.tw

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

RE: 請問如何利用vba刪除活頁簿中的工作表?

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

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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

TOP

        靜思自在 : 能付出愛心就是福,能消除煩惱就是慧。
返回列表 上一主題