เมื่อก่อนนี้ผมเขียนโปรแกรม Excel เพื่อทำรายงาน หรือจัดการกับข้อมูล ก็มักจะเริ่มจากข้อมูลจำนวนมากที่ ได้มาจาก SAP หรือ ฐานข้อมูลต่างๆ ในรูปแบบของ รายงาน ที่อาจจะไม่เป็น Table ที่พร้อมจะทำ Pivot Table หรือทำ Filter หรือทำกราฟ เช่นมี Sub Total หรือ มี  Format ของรายงาน เราก็จะเขียนโปรแกรมแปลงให้เป็น Table ก่อนจากนั้นก็แปลง Date ต่างๆให้เป็น Excel Date format ซึ่ง User จะเห็น Table วิ่งไปวิ่งมา เกิด Sheet ใหม่ที่มี Data ในรูปแบบของ Excel Table จากนั้นจึง สั่งให้ Excel ทำ Pivot Table หรือ Pivot Graph ฯลฯ ต่อไป

เมื่อสองวันก่อนนี้ทางโปรแกรมเมอร์ของบริษัทได้เขียน Excel โปรแกรมเพื่อทำรายงาน ผมสังเกตุว่าโปรแกรมของเขาทำงานเร็วมาก ไม่มีการสร้าง Sheet หรือ Table เพิ่มขึ้นแต่อย่างใด User ก็ไม่ต้องมาดู Excel Worksheet วิ่งไปวิ่งมา ก็เลยขออนุญาติแกะโปรแกรมดู ซึ่ง เขาก็ยินดี จึงได้เห็นว่ามืออาชีพเขาทำงานกันอย่างไร และขอนำมาแบ่งบันกันไว้ ในบล๊อคนี้ แต่อาจจะเป็นวิธีที่คนอื่นๆเขาทำกันเป็นปกติ ก็ยินดีจะแสดงความเชยไว้ณ. ที่นี้ด้วย

ผมไม่สามารถนำ Excel File โพสใว้ให้ Download ได้เพราะมีข้อมูลที่เป็นของบริษัท แต่จะตัดส่วนที่ไม่เป็นความลับของบริษัทมาให้ดูกันนะครับ

เริ่มจากการ Initialize User Interface

2015-04-13_144744

Sub InitilMenu()
    Dim ws As Worksheet
    Dim ws_dt As Worksheet
    Dim is_exit As Boolean
    
    Set ws = ActiveSheet
    
    ws.OLEObjects("cbShift1").Object.Value = True
    ws.OLEObjects("cbShift2").Object.Value = True
    ws.OLEObjects("cbShift3").Object.Value = True
    ws.OLEObjects("cbShift4").Object.Value = True
    ws.OLEObjects("cbLine1").Object.Value = True
    ws.OLEObjects("cbLine2").Object.Value = True
    ws.OLEObjects("cbLine3").Object.Value = True
    ws.OLEObjects("cbLine4").Object.Value = True
    ws.OLEObjects("cbLine8").Object.Value = True
    ws.OLEObjects("cbLine9").Object.Value = True
    ws.OLEObjects("cbSupereasy").Object.Value = True
    ws.OLEObjects("cbEasy").Object.Value = True
    ws.OLEObjects("cbMedium").Object.Value = True
    ws.OLEObjects("cbHard").Object.Value = True
    ws.OLEObjects("cbVeryhard").Object.Value = True
    ws.OLEObjects("cbExtremlyhard").Object.Value = True
    
    With ws.OLEObjects("cbReportType").Object
        .Clear
        .AddItem "Average Color Change Overall"
        .AddItem "Average Color Change By Monthly"
        .AddItem "Each Production Line"
        .AddItem "Average Color Change Line"
        .AddItem "Each Shift"
    End With
    ws.OLEObjects("cbReportType").Object.Text = ws.OLEObjects("cbReportType").Object.List(0)
    
    '... Loading Down Time Report
    Set ws_dt = ActiveWorkbook.Sheets("DownTime Report")
    If ws_dt Is Nothing Then
        MsgBox ("The ""DownTime Report"" sheet is not found.")
    End If
    r% = 6
    tmp_str$ = ""
    Do
        If InStr(tmp_str$, ws_dt.Cells(r%, 14).Value) = 0 And ws_dt.Cells(r%, 12).Value = "DOWN" Then
            If tmp_str$ <> "" Then tmp_str$ = tmp_str$ + "|"
            tmp_str$ = tmp_str$ + ws_dt.Cells(r%, 14).Value
            With ws.OLEObjects("lbSectionGroup").Object
                .MultiSelect = fmMultiSelectMulti
                .AddItem ws_dt.Cells(r%, 14).Value
            End With
        End If
        r% = r% + 1
    Loop Until ws_dt.Cells(r%, 4).Value = "" And ws_dt.Cells(r% + 1, 4).Value = ""
    '... Set Default To "Scheduled Cleaning"
    For i% = 0 To ws.OLEObjects("lbSectionGroup").Object.ListCount - 1
        If ws.OLEObjects("lbSectionGroup").Object.List(i%) = "Scheduled Cleaning" Then
            ws.OLEObjects("lbSectionGroup").Object.Selected(i%) = True
        End If
    Next
    
    '... Set Display Options
    With ws.OLEObjects("cbxAxis").Object
        .Clear
        .AddItem "Shift"
        .AddItem "Line"
    End With
    ws.OLEObjects("cbxAxis").Object.Text = ws.OLEObjects("cbxAxis").Object.List(0)
    ws.OLEObjects("tbTargetLine1").Object.Value = 1.2
    ws.OLEObjects("cbShowTargetLine").Object.Value = True
End Sub

 From Sheet to Array

หัวใจที่ทำให้โปรแกรมทำงานเร็วโดยไม่ต้อง สร้าง Sheet ใหม่คือการเอาข้อมูลจาก Sheet ใส่ใน Array และทำงานบน Array

 

Private Sub Class_Initialize()
    Dim ws_sh As Worksheet
    Dim ws_ct As Worksheet
    Dim ws_dt As Worksheet
    Dim ws As Worksheet
    Dim tmp As String
    
    Call txtMsgBox("Loading .....")
    '... Loading Schedule Time
    Call txtMsgBox("Schedule Time Loading .....")
    n_stime = TimeValue("19:00")
    n_etime = TimeValue("07:00")
    d_stime = TimeValue("07:00")
    d_etime = TimeValue("19:00")
    
    Set ws_ss = ActiveWorkbook.Sheets("Shift Schedule")
    If ws_ss Is Nothing Then
        Call txtMsgBox("The ""Shift Schdule"" sheet is not found.")
    End If
    yyyy% = Int(Trim(Right(ws_ss.Range("A1").Value, 4)))
    dd# = 0
    For i% = 1 To 12
        If i% = 1 Then c% = 1 Else c% = (6 * (i% - 1)) + 1
        r% = 5
        Do
            dd# = dd# + 1
            r% = r% + 1
        Loop Until ws_ss.Cells(r%, c%).Value = ""
    Next
    ReDim sch_date(1 To dd#) As Date
    ReDim sch_shift1(1 To dd#) As String
    ReDim sch_shift2(1 To dd#) As String
    ReDim sch_shift3(1 To dd#) As String
    ReDim sch_shift4(1 To dd#) As String
    
    i% = 1
    dd# = 1
    For i% = 1 To 12
        If i% = 1 Then c% = 1 Else c% = (6 * (i% - 1)) + 1
        r% = 5
        Do
            sch_date(dd#) = DateValue(Trim(ws_ss.Cells(r%, c%).Value) + "/" + Str(i%) + "/" + Str(yyyy%))
            sch_shift1(dd#) = ws_ss.Cells(r%, c% + 2).Value
            sch_shift2(dd#) = ws_ss.Cells(r%, c% + 3).Value
            sch_shift3(dd#) = ws_ss.Cells(r%, c% + 4).Value
            sch_shift4(dd#) = ws_ss.Cells(r%, c% + 5).Value
            dd# = dd# + 1
            r% = r% + 1
        Loop Until ws_ss.Cells(r%, c%).Value = ""
    Next
    
    '... Loading Color Type
    Call txtMsgBox("Color Type Loading .....")
    Set ws_ct = ActiveWorkbook.Sheets("Color Type")
    If ws_ct Is Nothing Then
        Call txtMsgBox("The ""Color Type"" sheet is not found.")
    End If
    r% = 3
    c% = 4
    dd# = 0
    Do
        Do
            dd# = dd# + 1
            c% = c% + 1
        Loop Until ws_ct.Cells(r%, c%).Value = "" And ws_ct.Cells(r%, c% + 1).Value = ""
        r% = r% + 1
        c% = 4
    Loop Until ws_ct.Cells(r%, c%).Value = "" And ws_ct.Cells(r%, c% + 1).Value = ""
    ReDim ct_code(1 To dd#) As String
    ReDim ct_type(1 To dd#) As String
    r% = 3
    c% = 4
    dd# = 0
    Do
        Do
            dd# = dd# + 1
            ct_code(dd#) = Format(ws_ct.Cells(r%, 3).Value, "00") & Format(ws_ct.Cells(2, c%).Value, "00")
            ct_type(dd#) = ws_ct.Cells(r%, c%).Value
            c% = c% + 1
        Loop Until ws_ct.Cells(r%, c%).Value = "" And ws_ct.Cells(r%, c% + 1).Value = ""
        r% = r% + 1
        c% = 4
    Loop Until ws_ct.Cells(r%, c%).Value = "" And ws_ct.Cells(r%, c% + 1).Value = ""
    
    '... Loading Down Time Report
    Set ws_dt = ActiveWorkbook.Sheets("DownTime Report")
    If ws_dt Is Nothing Then
        Call txtMsgBox("The ""DownTime Report"" sheet is not found.")
    End If
    r% = 6
    dd# = 0
    Do
        dd# = dd# + 1
        r% = r% + 1
    Loop Until ws_dt.Cells(r%, 4).Value = "" And ws_dt.Cells(r% + 1, 4).Value = ""
    ReDim dt_line(1 To dd#) As String
    ReDim dt_type(1 To dd#) As String
    ReDim dt_upo(1 To dd#) As String
    ReDim dt_color(1 To dd#) As String
    ReDim dt_sdate(1 To dd#) As Date
    ReDim dt_edate(1 To dd#) As Date
    ReDim dt_stime(1 To dd#) As Date
    ReDim dt_etime(1 To dd#) As Date
    ReDim dt_t100(1 To dd#) As String
    ReDim dt_hrmm(1 To dd#) As String
    ReDim dt_status(1 To dd#) As String
    ReDim dt_downtime(1 To dd#) As String
    ReDim dt_section(1 To dd#) As String
    i% = 0
    r% = 6
    Do
        dt_line(dd# - i%) = ws_dt.Cells(r%, 2).Value
        dt_type(dd# - i%) = ws_dt.Cells(r%, 3).Value
        dt_upo(dd# - i%) = ws_dt.Cells(r%, 4).Value
        dt_color(dd# - i%) = Left(ws_dt.Cells(r%, 7).Value, 2)
        dt_sdate(dd# - i%) = DateValue(Replace(ws_dt.Cells(r%, 8).Value, ".", "/"))
        dt_edate(dd# - i%) = DateValue(Replace(ws_dt.Cells(r%, 9).Value, ".", "/"))
        dt_stime(dd# - i%) = TimeValue(Replace(ws_dt.Cells(r%, 8).Value, ".", "/"))
        dt_etime(dd# - i%) = TimeValue(Replace(ws_dt.Cells(r%, 9).Value, ".", "/"))
        dt_t100(dd# - i%) = ws_dt.Cells(r%, 10).Value
        dt_hrmm(dd# - i%) = ws_dt.Cells(r%, 11).Value
        dt_status(dd# - i%) = ws_dt.Cells(r%, 12).Value
        dt_downtime(dd# - i%) = ws_dt.Cells(r%, 13).Value
        dt_section(dd# - i%) = ws_dt.Cells(r%, 14).Value
        r% = r% + 1
        i% = i% + 1
    Loop Until ws_dt.Cells(r%, 4).Value = "" And ws_dt.Cells(r% + 1, 4).Value = ""
     
    Set ws = ActiveSheet
    
    For i% = 1 To 4
        is_shift(i%) = ws.OLEObjects("cbShift" + Trim(Str(i%))).Object.Value
    Next
    For i% = 1 To 9
        If i% = 5 Or i% = 6 Or i% = 7 Then
            is_line(i%) = False
        Else
            is_line(i%) = ws.OLEObjects("cbLine" + Trim(Str(i%))).Object.Value
        End If
    Next
    For i% = 1 To 6
        Select Case i%
            Case 1
                tmp = "Supereasy"
            Case 2
                tmp = "Easy"
            Case 3
                tmp = "Medium"
            Case 4
                tmp = "Hard"
            Case 5
                tmp = "Veryhard"
            Case 6
                tmp = "Extremlyhard"
        End Select
        is_color(i%) = ws.OLEObjects("cb" + tmp).Object.Value
    Next
    For i% = 1 To 12
        is_month(i%) = False
    Next
    For i% = 1 To UBound(dt_sdate)
        is_month(month(dt_sdate(i%))) = True
    Next
    
    xAxis = ws.OLEObjects("cbxAxis").Object.Value
    target1 = ws.OLEObjects("tbTargetLine1").Object.Value
    section_group = ""
    For i% = 0 To ws.OLEObjects("lbSectionGroup").Object.ListCount - 1
        If ws.OLEObjects("lbSectionGroup").Object.Selected(i%) Then
            If section_group = "" Then
                section_group = ws.OLEObjects("lbSectionGroup").Object.List(i%)
            Else
                section_group = section_group + "|" + ws.OLEObjects("lbSectionGroup").Object.List(i%)
            End If
        End If
    Next
    is_show_target = ws.OLEObjects("cbShowTargetLine").Object.Value
    
    Call txtMsgBox("Loading complete.")
    Call process
End Sub

 

 

 

 

 

Leave a Reply