Snasui Excel Forum

Code: Select all

Sub DeleteSheetsByName()
    Dim ws As Worksheet
    Dim sheetNamesToDelete() As Variant
    Dim sheetName As Variant
    sheetNamesToDelete = Array("T_01", "T_02", "S_01", "S_02")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
        For Each sheetName In sheetNamesToDelete
            If ws.Name = sheetName Then
                On Error Resume Next
                ws.Delete
                On Error GoTo 0
                Exit For
            End If
        Next sheetName
    Next ws
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "ลบชีทเสร็จเรียบร้อย"
End Sub

Code: Select all

Sub DeleteSheets_ByName()
    Dim ws As Worksheet
    Dim sheetNamesToDelete() As Variant
    Dim sheetName As Variant, i As Integer
    sheetNamesToDelete = Array("T_01", "T_02", "S_01", "S_02")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
'        For Each sheetName In sheetNamesToDelete
        For i = LBound(sheetNamesToDelete) To UBound(sheetNamesToDelete)
            If sheetNamesToDelete(i) = ws.Name Then
'                On Error Resume Next
                ws.Delete
'                On Error GoTo 0
'                Exit For
            End If
        Next i
'        Next sheetName
    Next ws
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "ลบชีทเสร็จสิ้น"
End Sub

Code: Select all

Sub DeleteSheetsByName()
    Dim ws As Worksheet
'    Dim sheetNamesToDelete() As Variant
    Dim sheetNamesToDelete As String
    Dim sheetName As Variant
'    sheetNamesToDelete = Array("T_01", "T_02", "S_01", "S_02")
    sheetNamesToDelete = "T_01,T_02,S_01,S_02"
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
'        For Each sheetName In sheetNamesToDelete
            If InStr(sheetNamesToDelete, ws.Name) Then
'                On Error Resume Next
                ws.Delete
'                On Error GoTo 0
'                Exit For
            End If
'        Next sheetName
    Next ws
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "ลบชีทเสร็จสิ้น"
End Sub

Code: Select all

Sub DeleteSheetsWithPrefix()
    Dim ws As Worksheet
    Dim i As Long
    Dim prefixList As Variant
    Dim prefix As Variant
    Dim deleteSheet As Boolean
    
    ' ปิดแจ้งเตือน
    Application.DisplayAlerts = False
    
    ' กำหนดคำนำหน้า (Prefix) ที่ต้องการลบ
    prefixList = Array("T_", "S_")
    
    ' วนลูปจากหลังมาหน้าเพื่อป้องกัน error ขณะลบ
    For i = ThisWorkbook.Sheets.Count To 1 Step -1
        deleteSheet = False
        For Each prefix In prefixList
            If UCase(Left(ThisWorkbook.Sheets(i).Name, Len(prefix))) = UCase(prefix) Then
                deleteSheet = True
                Exit For
            End If
        Next prefix
        
        ' ถ้าตรงเงื่อนไขให้ลบ
        If deleteSheet Then
            ThisWorkbook.Sheets(i).Delete
        End If
    Next i
    
    ' เปิดแจ้งเตือนกลับ
    Application.DisplayAlerts = True
    
    MsgBox "ลบชีทที่มี Prefix T_, S_เรียบร้อยแล้ว", vbInformation
End Sub