ขอคำแนะนำในการปรับสูตร VBA ให้กระชับขึ้นครับ

[eak108035]

สวัสดีครับ คือผมบันทึก Macro เพื่อเปิดไฟล์และเรียงลำดับข้อมูล ทุกไฟล์ใน Folder ABC ซึ่งจะมีรูปแบบไฟล์ดังนี้ครับ XXX_พ.ศ.เดือน.XLS จำนวน 19ไฟล์ (12เดือน) ตัวอย่างชื่อไฟล์ 010_5906.XLS , T08_5906.XLS , U01_5906.XLS , 177_5906.XLS โดยตอนนี้ผมต้องเขียนเป็น 19คำสั่ง ต่อ1เดือน ซึ่งต้องทำทั้ง12เดือน(ตามตัวอย่างไฟล์แนบครับ)
จึงอยากจะขอคำแนะนำครับว่าพอจะมีวิธีปรับสูตรให้กระชับขึ้นหรือเปล่าครับ
ขอขอบคุณล่วงหน้าครับ

Code: Select all

Sub Macro6()
'
' Macro8 แมโคร
'

    '1
    Dim resp As Integer
    resp = MsgBox("ท่าน ต้องการจะเรียงข้อมูล นะครับ!", vbCritical + vbOKCancel, "ยืนยัน")
         If resp = vbCancel Then Exit Sub
    ChDir "D:\ABC"
    Workbooks.Open Filename:="[color=#FF0000]D:\ABC\010_5906.XLS[/color]"
    Sheets("Sheet1").Select
    Range("A7").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("AA:AA") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("X:X") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A7:AY900")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A7").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
    '2

    ChDir "D:\SLC"
    Workbooks.Open Filename:="[color=#FF0000]D:\ABC\T08_5906.XLS[/color]"
    Sheets("Sheet1").Select
    Range("A7").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("AA:AA") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("X:X") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A7:AY900")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A7").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    '3...
    '4...
    '5...
End Sub

[snasui]

สามารถ Loop เข้าไปใน Folder เพื่อจัดการกับทุกไฟล์ได้เลย จะได้ไม่ต้องเขียน Code ให้จัดการทีละไฟล์ ดูตัวอย่าง Code ที่นี่ครับ Looping through all files

[eak108035]

ขอบคุณมากครับ และต้้องขอโทษที่เข้ามาตอบช้าครับ