การแปลงข้อมูลแบบรายงานให้เป็น Database ด้วย VBA

กรณีที่ต้องทำงานกับข้อมูลที่ถูกแปลงมาเป็นรายงานแล้วนั้น ค่อนข้างจะยุ่งยากลำบากในการนำมาจัดการต่อ ไม่ว่าจะเป็นการค้นหาข้อมูล การจัดเรียง การนำไปแสดงเป็นกราฟ ฯลฯ ในหลายกรณีจึงจำเป็นต้องนำข้อมูลมาเรียงเสียใหม่ให้เป็น Database เพื่อให้ง่ายต่อการใช้งาน และในบางครั้งจำเป็นต้องทำการลบข้อมูลที่ไม่จำเป็นทิ้งไปเพื่อให้เหลือเฉพาะข้อมูลที่ต้องการใช้งานเท่านั้น

ยกตัวอย่างมีข้อมูลสัญญาใน Sheet1 ซึ่งมี 4 คอลัมน์ คือ คอลัมน์ที่

1. เลขที่สัญญา
2. ปี
3. เดือน
4. จำนวนเงิน

ได้ถูกจัดเรียงไปทางขวาจำนวน 8 ชุดข้อมูล ซึ่งต้องการนำมาจัดเรียงใหม่เป็น Database ตาม Sheet2 และต้องการลบบรรทัดที่ค่าเดือนมีค่าเป็นศูนย์ทิ้งไปด้วยดังภาพตัวอย่างด้านล่าง

ภาพตัวอย่างข้อมูลแบบรายงานและข้อมูลหลังแปลงเป็น Database

เราสามารถใช้ VBA ตามด้านล่างมาจัดการได้ครับ

Option Explicit

Sub ReRangeData()
    Dim rs As Range, rt As Range
    Dim r As Range, rAll As Range
    Dim lng As Long, lngLr As Long
    Dim i As Integer, c As Integer
    Application.ScreenUpdating = False
    lngLr = Rows.Count
    Worksheets("Sheet1").Range("A1:D1") _
        .Copy Worksheets("Sheet2").Range("A1")
    With Worksheets("Sheet1")
        Set rs = .Range("A2", .Range("A2").End(xlDown))
        i = rs.Count
    End With
    For lng = 1 To 8
        With Worksheets("Sheet2")
            Set rt = .Range("A" & lngLr).End(xlUp).Offset(1, 0)
            rs.Copy rt
            Set rs = rs.Offset(0, 1 + c).Resize(, 3)
            Set rt = .Range("B" & lngLr).End(xlUp).Offset(1, 0)
            rs.Copy rt
            Set rAll = .Range("C2").End(xlDown).Offset(-i + 1, 0).Resize(i)
        End With
        For Each r In rAll
            If r = 0 Then
                r = ""
            End If
        Next r
        rAll.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        With Worksheets("Sheet1")
            Set rs = rs.End(xlToLeft).Resize(i, 1)
        End With
        c = c + 3
    Next lng
    Application.ScreenUpdating = True
End Sub