สอบถาม Code vba ลบชีทที่ต้องการ

[tigerwit]

จากไฟล์ที่แนบมา

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

ต้องการลบชีท ที่มีชื่อชีท ขึ้นต้นด้วย T_ S_ และ K_ ทั้งหมด ต้องปรับโค๊ดอย่างไรครับ

[snasui]

ตัวอย่างการปรับ Code ครับ

แบบเก็บชื่อชีตไว้ใน Array

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

แบบเก็บชื่อชีตไว้ใน String

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

[tigerwit]

ขอบคุณครับ
ยังไม่ได้ตามความต้องการครับ
อธิบายความต้องการเพิ่มเติมครับ
ชีทจะถูกสร้างมาทุกครั้งที่มีการบันทึกงาน โดยตั้งชื่อชีทเป็น T_01 T_02..........เรื่อย ๆ อาจถึง T_30 ก็เป็นได้ แล้วแต่การบันทึก
เพราะฉะนั้นจึงไม่สามารถเขียนชื่อชีทนั้นได้ทุกชื่อเพื่อให้ลบได้
ความต้องการคือ ให้โค๊ดตรวจสอบดูว่าชื่อชีทใดที่ขึ้นต้น 2 ตัวหน้าเป็น "T_" และ "S_" ให้ลบให้หมด

[puriwutpokin]

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

[tigerwit]

ขอบคุณครับ