Code เรียงตามวันที่ก่อนหลังและเรียงตามลำดับเลขที่ค่ะ

[suka]

เรียนอาจารย์และท่านผู้รู้ค่ะ

ไฟล์แนบ PO.xlsm ชีท Form เมื่อกดปุ่ม Record ให้นำข้อมูลไปวางที่ไฟล์ DB.xlsx ชีท Sheet1 โดยเรียงตามวันที่เรียงก่อนหลังที่คอลัมน์ A และเรียงตามลำดับเลขที่เอกสารที่คอลัมน์ D

ติดที่โค๊ดนี้ยังแก้ไม่ได้ค่ะ ยังติดปัญหาทีไฟล์ DB.xlsx ชีท Sheet1 ระบายสีแดงไว้ และที่ต้องการได้ระบายสีเหลืองไว้ค่ะ

Code: Select all

With wbShare
       Set shRange = .Sheets("Sheet1").Range("A1", .Range("Z" & Rows.Count).End(xlUp))
       shRange.Borders.LineStyle = xlContinuous
       shRange.Sort Key1:=.Sheets("Sheet1").Range("D2"), Order1:=xlAscending, Header:=xlGuess
End With

นำมาใช้กับโค๊ดชุดนี้ค่ะ

Code: Select all

Sub PasteData()
        Dim wbShare As Workbook
        Dim formBook As Workbook
        Dim rTarget As Range
        Dim i As Integer
        Dim E As Long
        Dim rs As Range
        Dim rt As Range
        Dim rd As Range
        Dim shRange As Range

        Set formBook = ThisWorkbook
        Set wbShare = Workbooks("DB.xlsx")
        On Error Resume Next
        wbShare.Sheets("Sheet1").ShowAllData
        With wbShare
                E = .Sheets("Sheet1").Range("f" & Rows.Count).End(xlUp).Value + 1
                Select Case formBook.Sheets("Form").Range("o2").Value
                        Case "ใบกำกับภาษี"
                            E = formBook.Sheets("Sheet1").Range("c2")
                        Case "ใบส่งสินค้าชั่วคราว"
                            E = formBook.Sheets("Sheet1").Range("c3")
                End Select
                formBook.Worksheets("Form").Range("m2").Value = E
        End With
       
         wbShare.Save
       
        With formBook
                i = .Worksheets("Form").Range("C225").Value
        End With
        With formBook.Worksheets("Template")
                Set rs = .Range(.Range("A2"), .Range("Z" & i + 1))
        End With
                Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                        If formBook.Worksheets("Form").Range("C225") = True Then
                        End If
            With wbShare
                    Set shRange = .Sheets("Sheet1").Range("A1", .Range("Z" & Rows.Count).End(xlUp))
                    shRange.Borders.LineStyle = xlContinuous
                    shRange.Sort Key1:=.Sheets("Sheet1").Range("D2"), Order1:=xlAscending, Header:=xlGuess
           End With
      
        If formBook.Worksheets("Form").Range("B204") = "" Then
                MsgBox "Your data is empty. Fill your data and click record button again."
            Exit Sub
        End If
             rs.Copy: rt.PasteSpecial xlPasteValues
            formBook.Save
            formBook.Activate
            formBook.Sheets("Form").Range("D2,B204:B220,D204:D220,D222, E204:F220,O204,N204:N220").ClearContents
End Sub

[DhitiBank]

ลองปรับแบบนี้ครับ

Code: Select all

With wbShare
       Set shRange = .Sheets("Sheet1").Range("A1", .Range("Z" & Rows.Count).End(xlUp))
       shRange.Borders.LineStyle = xlContinuous
       .Soft.SortFields.Clear
'เกณฑ์ที่สำคัญอันดับ 1
       .Sort.SortFields.Add Key:=.Range("a1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'เกณฑ์ที่สำคัญอันดับ 2
       .Sort.SortFields.Add Key:=.Range("d1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
       With .Sort
           .SetRange shRange
           .Header = xlYes
           .SortMethod = xlPinYin
           .MatchCase = False
           .Apply
       End With
End With

[suka]

ขอบคุณค่ะคุณ DhitiBank

ขออภัยค่ะ โพสต์ก่อนหน้านี้อธิบายปัญหาให้ไม่เคลียร์ ขออนุญาตอธิบายอีกรอบค่ะ

สิ่งที่ต้องการ
หากข้อมูลที่มีในไฟล์ DB.xlsx ชีท Sheet1 คอลัมน์ A เป็นวันที่เดียวกันที่คอลัมน์ D ให้เรียงลำดับตามเลขที่น้อยไปมาก หากข้อมูลที่มีในไฟล์ DB.xlsx ชีท Sheet1 คอลัมน์ A มีวันที่ต่างกันให้เรียงลำดับตามวันที่แทนค่ะ

[DhitiBank]

โค้ดตามด้านบนนั่นเป็นการเรียงลำดับตามที่คุณ suka บอกเลยครับ ผมลองทดสอบแล้ว ไม่ทราบว่าคุณ suka ลองทดสอบโค้ดหรือยังครับ

พอดีขอปรับตรง .[color=#FF0040]Soft[/color].SortFields.Clear ให้เป็น .[color=#0000FF]Sort[/color].SortFields.Clear ครับ สงสัยตอนคัดลอกมามือไปโดนอะไรสักอย่าง

Code: Select all

   With wbShare.Sheets(1)
        Set shRange = .Range("a1", .Range("z" & .Rows.Count).End(xlUp))
        shRange.Borders.LineStyle = xlContinuous
       .Sort.SortFields.Clear
'เกณฑ์ที่สำคัญอันดับ 1
       .Sort.SortFields.Add Key:=.Range("a1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'เกณฑ์ที่สำคัญอันดับ 2
       .Sort.SortFields.Add Key:=.Range("d1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
       With .Sort
           .SetRange shRange
           .Header = xlYes
           .SortMethod = xlPinYin
           .MatchCase = False
           .Apply
       End With
    End With

[suka]

พอดีขอปรับตรง .Soft.SortFields.Clear ให้เป็น .Sort.SortFields.Clear ครับ สงสัยตอนคัดลอกมามือไปโดนอะไรสักอย่าง

ได้ปรับโค๊ดแล้วรันยังไม่ได้ค่ะ ยังได้ตามรูปแนบค่ะ

[DhitiBank]

แปลกจริงครับ ผมลองรันดูก็ได้ตามรูปด้านล่างนี้ครับ

2015-10-13_154331.png (11.04 KiB) Viewed 139 times

[suka]

ได้นำโค๊ดล่าสุดของคุณ DhitiBank มาปรับใช้กับไฟล์ใช้งานจริง ที่คอลัมน์ F เลขที่เรียงลำดับได้แล้วค่ะ

แต่ยังติดที่คอลัมน์ B วันที่ ดูตัวอย่างจากรูปแนบค่ะ เซลล์ B33036 วันที่10 ต.ค.58 ยังต่อท้ายวันที่ 13 ต.ค.58 ค่ะ ต้องการให้เซลล์ B33036 ซึ่งเป็นวันที่10 ต.ค.58 ไปเรียงเข้ากลุ่มวันที่10 ต.ค.58 ด้วยค่ะ

Code: Select all

With wbShare.Sheets(1)
                Set shRange = .Range("b1", .Range("ad" & .Rows.Count).End(xlUp))
                shRange.Borders.LineStyle = xlContinuous
               .Sort.SortFields.Clear
        'เกณฑ์ที่สำคัญอันดับ 1
               .Sort.SortFields.Add Key:=.Range("b1") _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        'เกณฑ์ที่สำคัญอันดับ 2
               .Sort.SortFields.Add Key:=.Range("f1") _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               With .Sort
                   .SetRange shRange
                   .Header = xlYes
                   .SortMethod = xlPinYin
                   .MatchCase = False
                   .Apply
               End With
            End With

[snasui]

จาก Code ที่นำไปปรับใช้ Set shRange = .Range("b1", .Range("[color=#FF0000]ad[/color]" & .Rows.Count).End(xlUp)) พบว่าอ้างอิงถึงคอลัมน์ AD ไม่ทราบว่าข้อมูลจริงมีเท่าไรครับ

หากจะให้แน่นอน ควรนับคอลัมน์ B ว่าบรรทัดสุดท้ายคือบรรทัดใดแล้วกำหนดบรรทัดสุดท้ายนั้นให้กับคอลัมน์ AD

ยกตัวอย่าง Code

Code: Select all

'...
dim lastRow as long
with sheets(1)
    lastRow = .range("b" & .rows.count).end(xlup).row
    Set shRange = .Range("b1:ad" & lastRow)
end with
'...

[suka]

ปรับโค๊ดให้เรียงข้อมูลได้ตามต้องการแล้วค่ะอาจารย์

ยังติดที่โค๊ดด้านล่างนี้ไม่ต้องการใช้เส้นขอบ ควรปรับไรคะ

Code: Select all

With wbShare.Sheets(1)
                lastRow = .Range("b" & .Rows.Count).End(xlUp).Row
                Set shRange = .Range("b1:ad" & lastRow)
                shRange.Borders.LineStyle = xlContinuous
               .Sort.SortFields.Clear
        'เกณฑ์ที่สำคัญอันดับ 1
               .Sort.SortFields.Add Key:=.Range("b1") _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        'เกณฑ์ที่สำคัญอันดับ 2
               .Sort.SortFields.Add Key:=.Range("f1") _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               With .Sort
                   .SetRange shRange
                   .Header = xlYes
                   .SortMethod = xlPinYin
                   .MatchCase = False
                   .Apply
               End With
            End With

[suka]

ขอบคุณอาจารย์มากค่ะ ช่วยให้ผ่านปัญหาได้มากมาย ได้ตรงตามต้องการแล้วค่ะอาจารย์
ขอบคุณคุณ DhitiBank ด้วยค่ะ

ปรับ Code นี้

Code: Select all

shRange.Borders.LineStyle = xlContinuous 

เป็น

Code: Select all

shRange.Borders.LineStyle = xlNone