สอบถามการลบ Sheet ในไฟล์ Excel ครั้งละหลายๆ ไฟล์

[shikamaru]

อาจารย์ครับ รบกวนอีกครั้งครับ ผมได้นำ Code Delete sheet ที่อาจารย์ แก้ไข ให้ทดสอบใช้แล้วครับ
ถ้าไฟล์ Test 1 , Test 2 และ Test 3 มีชื่อ Sheet Name = Sheet 1 ก็จะไม่ถูกลบ ซึ่ง Code ของอาจารย์ใช้งานได้ดีเลยครับ

แต่ผมมีความอยากรู้เพิ่มเติมครับ คือ ถ้าไฟล์ Test 1, Test 2 และ Test 3 มีชื่อ sheet Name ที่ไม่ต้องการลบออก ไม่เหมือนกัน
เช่น Test 1 >> Sheet Name = AA
Test 2 >> Sheet Name = BB
Test 3 >> Sheet Name = CC

ความต้องการ คือ เลือกทั้ง 3 ไฟล์พร้อมกัน และให้ลบ Sheet อื่นที่ไม่เกี่ยวข้องออก จากไฟล์ โดยแต่ละไฟล์จะต้องเหลือ
Test 1 >> เหลือ Sheet Name = AA
Test 2 >> เหลือ Sheet Name = BB
Test 3 >> เหลือ Sheet Name = CC

ผมลองแก้ไข Code แล้วแต่ติด Error ครับ รบกวนอาจารย์แนะนำครับ

[shikamaru]

Code ที่ 1

Code: Select all

Sub RoundedRectangle2_Click()

'Sub DeleteSheet()

Dim i As Integer, strThisbook As Variant

strThisbook = Application.GetOpenFilename(Filefilter:= _
 "All File (*.*), *.*", Title:="Please select source file(s).", MultiSelect:=True)
        
If TypeName(strThisbook) = "Boolean" Then
        'MsgBox "Please select file(s)."
        Exit Sub
End If

Application.DisplayAlerts = False
For i = 1 To UBound(strThisbook)
        Set thisBook = Workbooks.Open(strThisbook(i))
        Application.ScreenUpdating = False
        For Each sh In thisBook.Worksheets
            If sh.Name <> "AA" Then
                sh.Delete
            Else
            If sh.Name <> "BB" Then
                sh.Delete
            Else
            If sh.Name <> "CC" Then
                sh.Delete
                        
            End If
        Next sh
        
        thisBook.Close True
Next i
Application.DisplayAlerts = True
End Sub

[shikamaru]

Code ที่ 2

Code: Select all

Sub RoundedRectangle2_Click()

'Sub DeleteSheet()

Dim i As Integer, strThisbook As Variant

strThisbook = Application.GetOpenFilename(Filefilter:= _
 "All File (*.*), *.*", Title:="Please select source file(s).", MultiSelect:=True)
        
If TypeName(strThisbook) = "Boolean" Then
        'MsgBox "Please select file(s)."
        Exit Sub
End If

Application.DisplayAlerts = False
For i = 1 To UBound(strThisbook)
        Set thisBook = Workbooks.Open(strThisbook(i))
        Application.ScreenUpdating = False
        For Each sh In thisBook.Worksheets
            If sh.Name <> "AA" Or "BB" Or "CC" Then
                sh.Delete
                                  
            End If
        Next sh
        
        thisBook.Close True
Next i
Application.DisplayAlerts = True
End Sub

[shikamaru]

ไฟล์แนบครับ
ในไฟล์แนบ ผมมี Code ที่ 2 นะครับอาจารย์

[shikamaru]

ไฟล์ Test

[snasui]

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

Code: Select all

'--Other code
For Each sh In thisBook.Worksheets
	if thisBook.Name = "Test 1.XLSX" Then
		If sh.Name <> "AA" Then
			sh.Delete
		End If
	Elseif thisBook.Name = "Test 2.XLSX" Then
		If sh.Name <> "BB" Then
			sh.Delete
		Else
	ElstIf thisBook.Name = "Test 3.XLSX" Then
		If sh.Name <> "CC" Then
			sh.Delete
		End If			
	End If
Next sh
'--Other code

[shikamaru]

ขอบคุณครับ อาจารย์

[shikamaru]

รบกวนอาจารย์เพิ่มเติมครับ
พอดีไฟล์งานที่ผมต้องทำการลบ Sheet ชื่อไฟล์งานที่โหลดมาจะมีวันที่กำกับอยู่ด้านหลัง
เช่น Sales01012027.xlsx ซึ่งวันที่จะรันตามลำดับวัน ครับ จะทำให้ไฟล์ที่โหลดมาชื่อไฟล์จะไม่เหมือนเดิมทุกวัน
หากใช้ Code Delete Sheet ที่อาจารย์แก้ไขให้นั้น ผมต้องเปลี่ยนชื่อไฟล์ให้ตรงกับที่เขียน Code
ผมเลยแก้ไข Code นิดหน่อย เพื่อให้สามารถเลือกไฟล์มาลบ Sheet ได้โดยไม่ต้องเปลี่ยนชื่อไฟล์ให้ตรงกับใน Code
ผมกดรันแล้วไม่ Error แต่ผลลัพธ์ที่ได้ คือ ไม่มีการลบ Sheet ให้ครับ รบกวนอาจารย์อีกครั้งครับ

[shikamaru]

Code

Code: Select all

Sub RoundedRectangle2_Click()

'Sub DeleteSheet()

Dim i As Integer, strThisbook As Variant
Dim sh As Worksheet, thisBook As Workbook
Dim ob As Workbook

strThisbook = Application.GetOpenFilename(Filefilter:= _
 "All File (*.*), *.*", Title:="Please select source file(s).", MultiSelect:=True)
        
If TypeName(strThisbook) = "Boolean" Then
        'MsgBox "Please select file(s)."
        Exit Sub
End If

Application.DisplayAlerts = False
For i = 1 To UBound(strThisbook)
        Set thisBook = Workbooks.Open(strThisbook(i))
        Application.ScreenUpdating = False
        For Each sh In thisBook.Worksheets
 If thisBook.Name = "All file ,*.xlsx" Then
            If sh.Name <> "AA" Then
            sh.Delete
            End If
            
        ElseIf thisBook.Name = "All file ,*.xlsx" Then
            If sh.Name <> "BB" Then
                sh.Delete
            End If
         ElseIf thisBook.Name = "All file ,*.xlsx" Then
            If sh.Name <> "CC" Then
                sh.Delete
            End If
        End If

       Next sh
        thisBook.Close True
        
Next i
Application.DisplayAlerts = True
End Sub

[snasui]

เมื่อเป็นเช่นนั้นโปรแกรมจะทราบได้อย่างไรหรือใช้หลักการใดพิจารณาว่าไฟล์ใดจะต้องลบชีตใด ช่วยแจ้งมาด้วยครับ

[shikamaru]

ไม่เป็นไรครับอาจารย์ ผมใช้วิธีการเปลี่ยน Code ด้านหลังในส่วนของชื่อไฟล์ แทนครับ ใช้ได้เหมือนกัน
ขอบคุณครับ