เปลี่ยนชื่อ sheet ตาม cell

[neziices]

ขออนุญาตสอบถามค่ะ ถ้าต้องการจะเพิ่มลูปเปลี่ยนชื่อชีททั้งหมดตั้งแต่ sheet2 เป็นต้นไป (เปลี่ยนแค่ตัวเลข) และอยากให้ชื่อชีทยังอยู่เหมือนเดิม สามารถทำได้มั้ยคะ จากโค้ดที่ลองเขียน

Code: Select all

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim WS As Worksheet
  Dim i As Integer
    Set WS = ActiveSheet
        If Target.Address(0, 0) = "R5" Then
            WS.Name = WS.Range("R5").Value & "00" & i + 1
    
  End If
    
End Sub

[snasui]

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

[neziices]

ขออภัยค่ะอาจารย์แนบไฟล์ให้ใหม่แล้วค่ะ

[snasui]

ตัวอย่าง Code เปลี่ยนชื่อชีตโดยใส่เลขลำดับต่อท้ายเข้าไปครับ

Code: Select all

Sub Test0()
    Dim sh As Worksheet, i As Integer
    
    i = 1
    For Each sh In Worksheets
        If sh.Index > 1 Then
            sh.Name = sh.Name & "_" & VBA.Format(i, "00")
            i = i + 1
        End If
    Next sh
End Sub

ลองปรับปรุงมาเองก่อน ติดแล้วค่อยถามกันต่อ

ควรอธิบายพร้อมยกตัวอย่างประกอบว่าต้องการเปลี่ยนจากชื่อใดเป็นชื่อใด ด้วยเงื่อนไขใด จะได้ตอบได้ตรงประเด็น ลดเวลาซักถามไปมาได้มากครับ

[neziices]

ความต้องการคืออยากให้ชื่อชีททั้งหมดเปลี่ยนตาม cell R5 โดยมีการรรันเลขตามลำดับด้วยการกด enter ยกตัวอย่างเช่นชื่อเดิมคือ 2501001 - aa เปลี่ยนเป็น 2502001 - aa ค่ะ

[snasui]

หมายถึงเซลล์ R5 ของแต่ละชีตใช่หรือไม่ครับ

หากใช่ก็เปลี่ยน sh.Name = sh.Name & "_" & VBA.Format(i, "00") เป็น sh.Name = sh.range("r5").value ได้เลยครับ

วิธีนี้ไม่ได้ใช้ Change Event แต่เป็นการรันรวดเดียว ไม่ทราบว่าใช่ที่ต้องการหรือไม่ หากไม่ใช่กรุณาอธิบายลำดับวิธีการทำงานและแจ้งที่สิ่งที่ต้องการมาอีกรอบครับ

[neziices]

ลองทำการใส่โค้ดตามที่อาจารย์แนะนำมาแต่ยังไม่เกิดการเปลี่ยนแปลงค่ะ

ลำดับการทำงานคือเปลี่ยนตัวเลขที่ cell R5 และกด enter เพียงครั้งเดียวให้เปลี่ยนชื่อชีท (ที่เป็นตัวเลข) ทุกชีทที่มีในไฟล์
ยกตัวอย่างเช่น ต้องการเปลี่ยนชื่อ sheet2 ถึง sheet5 โดยเปลี่ยนแค่ตัวเลขจาก 2502001-2502004 เป็น 2503001-2503004 ชื่อชีทที่เป็นตัวอักษรภาษาอังกฤษยังอยู่คงเดิมค่ะ

[snasui]

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

Code: Select all

Sub Test0()
    Dim Sh As Worksheet, i As Integer
    Dim strPre As String
    
    strPre = Worksheets(2).Range("r5").Value
    For Each Sh In Worksheets
        If Sh.Index > 1 Then
            Sh.Name = strPre & VBA.Mid(Sh.Name, 5)
        End If
    Next Sh
End Sub

นำ Code ด้านบนไปใส่ใน Module1

การรัน Code สามารถสร้างปุ่มขึ้นมาคลิกหรือไม่ก็ได้ หรือหากต้องการจะใช้ Change Event ก็ลองเขียนมาเองก่อน

สำหรับการรันโดยไม่คลิกปุ่มให้กดแป้น Alt+F8 > เลือก Test0 แล้วคลิก Run