Board logo

標題: [發問] 刪除部分工作表 [打印本頁]
作者: asch2007    時間: 2014-10-9 16:07     標題: 刪除部分工作表

我把要刪除的工作表名稱都放在A欄
但不知那裏有錯,懇請各位高手賜教
感激不盡
  1. For Each sht In Worksheets
  2.       
  3.   For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
  4.       
  5.       If sht.name = Cells(i, 1) Then
  6.       
  7.       sht.Delete
  8.       
  9.       
  10.       End If
  11.       
  12.       Application.DisplayAlerts = False

  14.                               
  15.     Next
  16.       

  18. Next
  19.          
  20.    
  21. End Sub
複製代碼
作者: 蝕光迴狼    時間: 2014-10-9 17:59

回復 1# asch2007


麻煩請詳述，程式執行後，你想要呈現的結果。

不然想幫忙的人，寫出來的程式碼，可能會跟你要的結果，有很大落差
作者: GBKEE    時間: 2014-10-9 20:04

回復 1# asch2007
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim sht As Worksheet, i As Integer
  4.     Application.DisplayAlerts = False
  5.     With ActiveWorkbook
  6.         For Each sht In .Worksheets
  7.             For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
  8.                 If sht.Name = Cells(i, 1) And .Sheets.Count > 1 Then
  9.                 '.Sheets.Count > 1 '活頁簿必須有一張的工作表存在.
  10.                     sht.Delete
  11.                 End If
  12.             Next
  13.         Next
  14.     End With
  15. End Sub
複製代碼
作者: asch2007    時間: 2014-10-13 11:16

回復 2# 蝕光迴狼


很抱歉沒說清楚
我想要刪除多餘的工作表，但不是全刪
要刪除工作表的名稱，放在另一個工作表中

我嚐試寫了一段程式，執行中間有出錯
錯誤訊息：
執行階段錯誤'424':
此處需要物件

偵錯結果停在
If sht.name = Cells(i, 1) Then

但我不知錯那裏
希望各位大大指點迷津

感激不盡
作者: luhpro    時間: 2014-10-13 21:30

本帖最後由 luhpro 於 2014-10-13 21:32 編輯

回復 4# asch2007
那是因為 在
  sht.Delete
這一行時 sht 物件被刪掉了.

但是 For Next 迴圈還是繼續在執行,
於是跑到
If sht.Name ...
這一行時 Sht 物件已經不存在所以 "找不到物件".

底下兩種方式都可以不再出現此錯誤訊息.
  1.   Application.DisplayAlerts = False
  2.   For Each sht In Worksheets
  3.     For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
  4.       If Not IsEmpty(sht) Then
  5.         If sht.Name = Cells(i, 1) Then sht.Delete
  6.       End If
  7.     Next
  8.   Next
  9.   Application.DisplayAlerts = True
複製代碼
  1.   Application.DisplayAlerts = False
  2.   For Each sht In Worksheets
  3.     For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
  4.       If sht.Name = Cells(i, 1) Then
  5.         sht.Delete
  6.         Exit For
  7.       End If
  8.     Next
  9.   Next
  10.   Application.DisplayAlerts = True
複製代碼
作者: Hsieh    時間: 2014-10-14 09:23

回復 4# asch2007
  1. Sub ex()
  2. Dim Sh As Worksheet
  3. Set d = CreateObject("Scripting.Dictionary")
  4. For Each Sh In Sheets
  5.   Set d(Sh.Name) = Sh '暫存所有工作表
  6. Next
  7. With Sheets("工作表1") '欲刪除名單工作表
  8.   For Each a In .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
  9.      If d.exists(CStr(a)) = True Then d(CStr(a)).Delete '為防止以數字為名的工作表，故使用Cstr轉成字串
  10.   Next
  11. End With
  12. End Sub
複製代碼
作者: asch2007    時間: 2014-10-16 15:37

回復 5# luhpro


    感謝幫忙，測試結果第一個還是不行，但第二個成功！！
作者: asch2007    時間: 2014-10-16 15:38

回復 6# Hsieh


測試結果還是有問題，我再研究看看
感謝
作者: asch2007    時間: 2014-10-16 15:49

[attach]19351[/attach]

經測試結果只有"刪表二"成功
其他我再研究看看
作者: GBKEE    時間: 2014-10-16 19:47

回復 9# asch2007
  1. Sub 刪表()
  2.     Dim i As Integer, sht As Worksheet
  3.     Worksheets("刪表名單").Activate
  4.     Application.DisplayAlerts = False
  5.     For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
  6.         For Each sht In Worksheets
  7.             If sht.name = Cells(i, 1) Then sht.Delete
  8.         Next
  9.     Next
  10.     Application.DisplayAlerts = True
  11. End Sub
  12. Sub 刪表2()
  13. Dim i As Integer, sht As Worksheet
  14.     Worksheets("刪表名單").Activate
  15.     Application.DisplayAlerts = False
  16.     For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
  17.         For Each sht In Worksheets
  18.             If sht.name = Cells(i, 1) Then
  19.                 sht.Delete
  20.                 Exit For
  21.             End If
  22.         Next
  23.     Next
  24.     Application.DisplayAlerts = True
  25. End Sub
  26. Sub 刪表3()
  27.     Dim Sh As Worksheet, d As Object, a As Range
  28.     Set d = CreateObject("Scripting.Dictionary")
  29.     For Each Sh In Sheets
  30.         Set d(Sh.name) = Sh '暫存所有工作表
  31.     Next
  32.     Application.DisplayAlerts = False
  33.     With Sheets("刪表名單") '欲刪除名單工作表
  34.         For Each a In .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
  35.             If d.exists(CStr(a)) = True Then d(CStr(a)).Delete '為防止以數字為名的工作表，故使用Cstr轉成字串
  36.         Next
  37.     End With
  38.     Application.DisplayAlerts = True
  39. End Sub
  40. Sub 刪表_EX()
  41.     Dim i As Integer
  42.     Application.DisplayAlerts = False
  43.     With Worksheets("刪表名單")
  44.         On Error Resume Next
  45.         For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
  46.             .Parent.Sheets(.Cells(i, 1).Value).Delete
  47.         Next
  48.         On Error GoTo 0
  49.     End With
  50.     Application.DisplayAlerts = True
  51. End Sub
複製代碼




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