ดึงค่าตามเงื่อนไขและเรียงลำดับด้วย VBA

[aerojen]

อยากให้ พิมพ์เลขที่ในคอลัมน์ B3-B5 ข้อมูลจะต้องดึงมาจากชีท customer1,customer2
และดึง total เรียงจากมากสุด ไป น้อยสุด รวมถึงคอลัมน์ customer ดึงชื่อไฟล์มาใส่

ตอนนี้รันแล้วหายไปหมดคร้าบผม

[snasui]

ตอนนี้รันแล้วหายไปหมดคร้าบผม

คำที่ระบายสีไว้นั้นผิดกฎข้อ 1 ระมัดระวังด้วยครับ

สำหรับการทำ Advance Filter โดยเลือกมาเฉพาะบางคอลัมน์ เราไม่สามารถเลือกคอลัมน์ที่ไม่ติดกันได้ นอกจากนี้การเลือก Criteria ก็ควรเลือกให้พอดีกับ Criteria ทั้งหมด หากคลุมเลือกเกินไปกว่านั้นข้อมูลจะออกมาทั้งหมดครับ

ตัวอย่าง Code กรณีเลือกแค่ 2 คอลัมน์

Code: Select all

Sub Macro2()
    Sheets("Comparision").Range("B7:Z10000").ClearContents
    Sheets("Customer1").Range("D14:E1000").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("B2:B3"), CopyToRange:=Range("B7"), Unique:=False
End Sub

[aerojen]

ขอบคุณมากๆครับ ต้องขออภัยที่ทำผิดกฏห้องครับ
ถ้าผมอยากเพิ่มผลลัพธ์คือ อยากให้run ตามเลขที่ (คอลัมน์ B3:B5 ) โดยเอาชีท customer1และ2 มาเรียง ค่าtotal (คอลัมน์ M) จากมากสุดไปน้อยสุด จะทำได้มั้ยครับ
แล้วปัจจุบันใช้วิธีเพิ่มคอลัมน์ cutomer ในแต่ละชีท เพื่อลิ้งมาที่ชีท comparision พอจะมีวิธีที่ไม่เพิ่มคอลัมน์ แต่ดึงชื่อชีทมาใส่แทนเลยได้มั้ยครับ

[snasui]

ลองทำมาด้วยตนเองดูก่อน ติดแล้วค่อยถามกันครับ

แทนที่จะใช้การทำ Advance Filter ลงปลายทาง อาจจะทำการ Advance Filter ไปพักไว้ก่อนสักที่

การทำ Advance Filter จากข้อมูลหลายชีตมาต่อกันนั้น จะมีข้อจำกัดอย่างหนึ่งคือต้องลบค่าเดิมทิ้งไปก่อน การทำ Advance Filter แต่ละครั้งจะได้แค่ข้อมูลของครั้งนั้นๆ เท่านั้น เพราะต้องลบของเดิมทิ้งไป

หากเรานำไปพักไว้ก่อนแล้วค่อยนำค่าที่พักไว้นั้นมาเรียงต่อกันในปลายทางจะลดปัญหานี้ได้ หรือหากทำการ Loop โดย VBA โดยตรง ไม่ต้องผ่าน Advance Filter ก็สามารถทำได้

ทั้งหมดนี้รวมทั้งการเพิ่มชื่อชีตเข้ามา ต้องทำมาเองก่อน ติดแล้วค่อยถามกันครับ

[aerojen]

ขอบคุณมากครับ ลองทำวน loop ดูแล้วครับ ไม่ติดปัญหาการดึงข้อมูลรวม
แต่เราจะเพิ่มเงื่อนไขการดึงข้อมูลต้องดึงตามการใส่เลขที่ในคอลัมน์ B3-B5 ยังไงครับ
อย่างเช่นพิมพ์ 54001012 (8 หลัก) หรือพิมพ์ 5400 (4หลัก) ข้อมูลก็มาตามที่กำหนดให้และเรียงค่า total คอลัมน์ L จากมากสุดไปน้อยสุดยังไง

ช่วยหน่อยครับ

[snasui]

เปลี่ยน Cells.Select เป็น Range("a8").Resize(1000, 100).Select

และปรับช่วง While...Wend เป็นด้านล่างครับ

Code: Select all

While Len(Range(myNum & CStr(LSearchRow)).Value) > 0
    If Range(myColName & CStr(LSearchRow)).Value >= 1 And _
        InStr(Sheets(summarySheet).Range("b3"), _
        Range(CStr(LSearchRow) & ":" & CStr(LSearchRow))(4)) Then
        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
        Selection.Copy
        Sheets(summarySheet).Select
        Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
        ActiveSheet.Paste
        LCopyToRow = LCopyToRow + 1
        Sheets(sheetArray(i)).Select
    End If
    LSearchRow = LSearchRow + 1
Wend

กรณีการเรียงข้อมูล ลองบันทึก Macro แล้วปรับใช้ Code ดูก่อน ติดตรงไหนค่อยถามกันต่อครับ

[aerojen]

ขอบคุณมากๆครับ ได้ผลตามที่ต้องการแล้วครับ รวมถึงทำ Macro เรียงข้อมูลได้แล้ว
แต่แปลกมากๆครับ เมื่อนำมาทำกับข้อมูลจริง ที่มีหลายๆไฟล์ต้องการดึงข้อมูลเหมือนเดิมแต่ข้อมูลนั้นที่มีทั้ง #VALUE!, #REF!,N/A ข้อมูลไม่สามารถดึงมาได้ กด run แล้วข้อมูลไม่มาเลยครับ

เนื่องจากไฟล์ใหญ่เลยแนบมาไม่ได้ เราสามารถปรับสูตรให้รองรับข้อมูลที่ใหญ่ขึ้นได้มั้ยครับ อีกนิดนึงครับ เมื่อรันแล้วขึ้นว่า Subscript out of range คืออะไรครับ

[snasui]

ควรตัดมาเฉพาะส่วนที่ประกอบด้วยค่า Error แทนที่จะส่งมาทั้งไฟล์นั้นครับ

Error ที่กล่าวถึงสาเหตุหนึ่งเพราะโปรแกรมหาชีตไม่พบครับ

[aerojen]

อาจารย์ครับ ลองย่อไฟล์แล้วลองทำดูจากตัวอย่างจริงทำไม่ได้ครับ
ลักษณะเงื่อนไขไม่แตกต่างจากไฟล์ก่อนหน้าครับแค่เพิ่มจำนวนของข้อมูลที่ดึงมากขึ้นครับ

[snasui]

เปลี่ยน Range(CStr(LSearchRow) & ":" & CStr(LSearchRow))(4)) เป็น Range(CStr(LSearchRow) & ":" & CStr(LSearchRow))(3)) ครับ

ควรจะศึกษาให้เข้าใจใน Code ไม่เช่นนั้นจะไม่สามารถแก้ไขเองได้แม้เป็นการแก้ไขเพียงเล็กน้อยครับ