ต้องการเขียน Macro เพื่อการกรองข้อมูล

[yod001]

เมื่อเรามีข้อมูล (data) ต้องการจะกรองข้อมูล แล้วทำการแยกเป็น Sheet ทำอย่างไรจะสามารถ ใช้ Marco โดยทำการกดเพียงครั้งเดียวสามารถ กรองได้ทั้งหมด ครับ:hurray:

[excel_fever]

ผมว่าชื่อไฟล์แนบผิดกฏนะครับ

[yod001]

เป็นมือใหม่ครับ ขอโทษด้วยครับ:nonod:

[excel_fever]

ผมมีคำตอบอีกแบบให้พิจารณาครับ
แต่จะรอจนกว่าจะทำให้ถูกกฏซะก่อน เพราะผมก็ไม่อยากได้ใบเหลืองเหมือนกัน

[สมเกียรติ]

ขอให้ตั้งชื่อแฟ้มที่ต้องการแนบให้ตรงกับปัญหา
(อย่าตั้งชื่อแฟ้มว่า Book, Data, Sample, Problem, Test, Question, Ex, ตัวอย่าง, คำถาม, สอบถาม, ปัญหา หรือใช้ชื่อแฟ้มที่เห็นแล้วไม่รู้ว่าเป็นแฟ้มถามเรื่องใด)

[yod001]

ขอบคุณ ครับ ผมได้ทำการตั้ง ชื่อ File ใหม่แล้วครับ

[excel_fever]

ผมก็อ่อนหัดเรื่องVBAครับ
ผมลองใช้ Macro บันทึกการทำงาน ปรากฏว่าใช้เวลาน้อยกว่าวิธีที่ผมบอกไปเมื่อวาน
นี่คือ Code ที่บันทึกได้ครับ
Sub Filter()
'
' Filter Macro
' Macro recorded 19/8/2009 by PC-07
'
'
Range("C1:F1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="Area 1"
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range("C2:E14").Select
Selection.Copy
Sheets("A").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data").Select
Selection.AutoFilter Field:=4, Criteria1:="Area 2"
Range("C1").Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range("C4").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range("C4:E15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("B").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data").Select
Selection.AutoFilter Field:=4, Criteria1:="Area 3"
Range("C6").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range("C6:E18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("C").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data").Select
Selection.AutoFilter Field:=4, Criteria1:="Area 4"
Range("C8").Select
Range(Selection, Selection.End(xlDown)).Select
Range("C8:E17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("D").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G8").Select
Sheets("Data").Select
Application.CutCopyMode = False
Selection.AutoFilter
Range("G12").Select
End Sub

[vajra]

ตัวอย่าง การ Filter แล้วย้ายข้อมูลไปใว้ใน new sheet
Data Subtraction II.xls

[yod001]

ขอบคุณมากๆๆครับ สำหรับการช่วยเหลือครับ
สามารถนำไปประยุกต์ การใช้งานได้ครับ :great: