การกระจายข้อมูลออกเป็นหลายชีตด้วย VBA

เราสามารถนำข้อมูลในชีตเดียวกันไปแสดงหลาย ๆ ชีตได้หลายวิธี เช่น ด้วยสูตร ด้วย PivotTable แต่ทั้งสองวิธีจะมีปัญหากับการเพิ่มลดข้อมูล เพราะไม่สามารถที่จะเพิ่มลดชีตได้อย่างอัตโนมัติ หากต้องการให้มีการเพิ่มลดชีตได้อย่างอัตโนมัติจำเป็นต้องพึ่งพา VBA

Video ด้านล่างนี้เป็นการเขียนโปรแกรมด้วย VBA ให้กระจายข้อมูลในชีตใด ๆ ออกเป็นหลายชีตตามค่าที่กำหนด โดยสามารถทำซ้ำได้ตามต้องการ กรณีที่เราทำซ้ำ โปรแกรมจะทำการลบชีตที่มีอยู่เดิมทิ้งไปก่อน จากนั้นค่อยเพิ่มชีตและนำข้อมูลมาวางใหม่ โดยมีตัวอย่าง Code ตามด้านล่างครับ

Sub DistributeDataToSheets()
    Dim r As Range, d As Object, s As Worksheet
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    For Each s In Worksheets
        If s.Name <> Sheets(1).Name Then
            s.Delete
        End If
    Next s
    With Sheets(1)
        For Each r In .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
            If Not d.Exists(r.Value) Then
                Set s = Worksheets.Add(after:=Worksheets(Sheets.Count))
                s.Name = r.Value
                s.Range("f1").Value = "CC"
                s.Range("f2").Value = r.Value
                .UsedRange.AdvancedFilter xlFilterCopy, _
                    s.Range("f1:f2"), s.Range("a1")
                s.Range("f1:f2").Clear
            End If
        Next r
    End With
    Application.ScreenUpdating = True
    MsgBox "Finish", vbInformation
End Sub

📹 Video แสดงการกระจายข้อมูลออกเป็นหลายชีต

---

🧭 Timeline หัวข้อหลัก

• 00:00:13 แนะนำวัตถุประสงค์: แยกข้อมูลจากชีตเดียวออกเป็นหลายชีตตาม Cost Center
• 00:00:40 เปิด VBE และสร้าง Module สำหรับเขียนโค้ด
• 00:01:08 ประกาศตัวแปร: Range, Object, Worksheet
• 00:01:28 สร้าง Scripting Dictionary เพื่อเก็บค่า Cost Center
• 00:02:02 ลบชีตเดิมก่อนสร้างใหม่เพื่อป้องกันซ้ำ
• 00:03:02 Loop เข้าไปในข้อมูลคอลัมน์ B เพื่อเก็บค่า Cost Center
• 00:04:12 สร้างชีตใหม่ตามค่า Cost Center ที่พบ
• 00:05:08 ใช้ Advanced Filter เพื่อกรองข้อมูลเฉพาะกลุ่ม
• 00:07:09 ล้างค่า Criteria และแจ้งผู้ใช้ด้วย Message Box