VBA ดึงข้อมูลตามวันที่ ต้องการให้ดึงเลขที่เอกสารด้วยค่ะ

[suka]

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

โค๊ดดึงข้อมูลวันที่จากค่าในเซลล์ F4 ชืท Edit เทียบค่าวันที่ตรงกับคอลัมน์ B ชีท Database ให้นำข้อมูลตามวันที่ๆตรงกันมาวางที่เซลล์ A5:D ชืท Edit

ติดปัญหาเลขที่จากคอลัมน์ B ชีท Database ไม่สามารถดีงมาวางที่คอลัมน์ A ชีท Edit ค่ะ

ไฟล์แนบดัวอย่างค่าที่ต้องการที่เซลล์ I5:L21 ชีท Edit ค่ะ

โค๊ดนี้ควรปรับอย่างไรคะ ขอบคุณค่ะ

Code: Select all

Sub EditDT()
    Sheets("Edit").Range("A5:D100").ClearContents
    Sheets("Database").Columns("C:E").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("F3:F4"), CopyToRange:=Range("B5"), Unique:=False
End Sub

[bank9597]

ปรับตามนี้ครับ

Code: Select all

Sub EditDT()
    Sheets("Edit").Range("A5:D100").ClearContents
    Sheets("Database").Columns("B:E").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("F3:F4"), CopyToRange:=Range("A5:D5"), Unique:=False
End Sub

[snasui]

ติดปัญหาเลขที่จากคอลัมน์ B ชีท Database ไม่สามารถดีงมาวางที่คอลัมน์ A ชีท Edit ค่ะ

เนื่องจากเลือกข้อมูลมาเฉพาะคอลัมน์ C:E จึงเป็นปกติที่ข้อมูลในคอลัมน์ A ไม่ติดมาด้วยครับ

[suka]

ปรับตามนี้ครับ

Code: Select all

Sub EditDT()
Sheets("Edit").Range("A5:D100").ClearContents
Sheets("Database").Columns("B:E").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("F3:F4"), CopyToRange:=Range("A5:D5"), Unique:=False
End Sub

ขอบคุณคุณ bank9597 มากค่ะ โค๊ดได้ตรงตามต้องการค่ะ

เนื่องจากเลือกข้อมูลมาเฉพาะคอลัมน์ C:E จึงเป็นปกติที่ข้อมูลในคอลัมน์ A ไม่ติดมาด้วยครับ

ขอบคุณอาจารย์มากค่ะ ทำให้ทราบว่าสามารถปรับได้หลักหลายค่ะ

Code: Select all

Sub EditDT()
    Sheets("Edit").Range("A5:D100").ClearContents
    Sheets("Database").Columns("B:E").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("F3:F4"), CopyToRange:=Range("A5"), Unique:=False
End Sub

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

[suka]

ขอรบกวนช่วยแนะนำการปรับข้อมูลวันที่จากไฟล์แนบชีท Database คอลัมน์ P:Q แทนการจัดฟอแมทค่ะ

จาก 9/7/2015 ให้เป็น ก.ค.และ 58
จาก 10/7/2015 ให้เป็น ก.ค.และ 58
จาก 17/8/2015 ให้เป็น ส.ค.และ 58
จาก 31/8/2015 ให้เป็น ส.ค.และ 58

ข้อมูลจำนวนมากควรปรับอย่างไร ปรับเพื่อต้องการนำมาใช้ได้กับโค๊ดด้านล่างนี้ค่ะ

Code: Select all

Sub MMM()
    Sheets("Report").Range("A10:Q1000").ClearContents
    Sheets("Database").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("E3:E4"), CopyToRange:=Range("A10"), Unique:=False
End Sub

[snasui]

Code ที่เขียนมานั้นผิดพลาดอย่างไร มีข้อความเตือนอะไรบ้างช่วยแจ้งมาด้วยครับ

[suka]

อาจารย์คะไม่ได้ติดที่ Code ค่ะ

ติดปัญหาที่ชีท Database คอลัมน์ P:Q ค่ะ
ตัวอย่างไฟล์แนบขอวิธีปรับค่าในเซลล์ P2:Q2 จาก 31/8/2015 P2 เป็น ส.ค. และ Q2 เป็น 58 ค่ะ

ปรับเพื่อให้ Code สามารถดึงข้อมูลมาทั้งเดือน ที่ชีท Report ตามเงือนไขค่าในเซลล์ E3:E4 เลือก ส.ค.ไม่สามารถดึงข้อมูลเดือน ส.ค.มาได้หากใส่ค่าที่เซลล์ E3:E4 เป็น 31/8/2015 ก็ดึงข้อมูลมาได้เฉพาะวันที่ 31/8/2015 ค่ะ

ความต้องการคือต้องการดึงข้อมูลของเดือน ส.ค.58 มาทั้งหมดค่ะ

[snasui]

ดึงมาไม่ได้ก็เป็นปกติแล้ว ถ้าดึงมาได้จึงจะผิดปกติครับ

การใช้ Advanced Filter โดยกำหนด Field ไว้เช่นนั้นจะต้องคีย์ค่าตรงตัวลงไปจึงจะ Filter มาได้

ตามที่อธิบายมานั้นหากจะใช้ Advanced Filter จะต้องใช้วิธีที่ซับซ้อนไปกว่าเดิม ให้ทำตามด้านล่างแล้วสังเกตดูผลครับ

ที่ชีท Report

1. ลบ E3:F3 ทิ้งไป
2. ที่ E4 คีย์
   =TEXT(Database!P2,"mmm")="ส.ค."
3. ที่ F4 คีย์
   =TEXT(Database!Q2,"bb")+0=58
4. Run Sub MMM

[suka]

ขอบคุณอาจารย์มากค่ะ Code Run ได้ตรงตามต้องการแล้วค่ะ

[suka]

ดึงมาไม่ได้ก็เป็นปกติแล้ว ถ้าดึงมาได้จึงจะผิดปกติครับ

การใช้ Advanced Filter โดยกำหนด Field ไว้เช่นนั้นจะต้องคีย์ค่าตรงตัวลงไปจึงจะ Filter มาได้

ตามที่อธิบายมานั้นหากจะใช้ Advanced Filter จะต้องใช้วิธีที่ซับซ้อนไปกว่าเดิม ให้ทำตามด้านล่างแล้วสังเกตดูผลครับ

ที่ชีท Report

1. ลบ E3:F3 ทิ้งไป
2. ที่ E4 คีย์
   =TEXT(Database!P2,"mmm")="ส.ค."
3. ที่ F4 คีย์
   =TEXT(Database!Q2,"bb")+0=58
4. Run Sub MMM

อาจารย์คะ พอมีวิธีอื่นที่ไม่ซับซ้อนไหมคะ
ที่ E4 คีย์
=TEXT(Database!P2,"mmm")="ก.ย."
ใช้ไม่ได้ค่ะค่าเป็น FALSE ไม่ใช่ TRUE ค่ะ ควรปรับอย่างไรดีคะ

[snasui]

ใช้ไม่ได้ค่ะค่าเป็น FALSE ไม่ใช่ TRUE ค่ะ ควรปรับอย่างไรดีคะ

จะ True หรือ False ไม่ใช่ปัญหาครับ ปัญหาคือมีเดือน ก.ย. อยู่หรือไม่เท่านั้นครับ

[suka]

จะ True หรือ False ไม่ใช่ปัญหาครับ ปัญหาคือมีเดือน ก.ย. อยู่หรือไม่เท่านั้นครับ

ขอบคุณค่ะอาจารย์ เห็นเป็น False ยังไม่ทันได้ลอง Run Code ค่ะ Run แล้วได้ตรงตามต้อการค่ะ

ขออนุญาตถามต่อค่ะ
ต้องการปรับ MainCode ตัวอย่างไฟล์แนบ ถ้าเซลล์ A4:D4 เซลล์ใดมีค่าก็ให้ดึงข้อมูลตามเงื่อนไขมา หากเซลล์ใดว่างให้ข้าม และที่เซลล์ E4:F4 มีค่าให้ดึงข้อมูลตามเงื่อนไขเซลล์ E4:F4 มาด้วย ถ้าเซลล์ E4:F4 ว่างให้ข้ามค่ะ

ค่าที่ต้องการที่เซลล์ C4 ใส่ ส004 และเซลล์ E4:F4 ใส่ ก.ย.58 ตัวอย่างที่ต้องการตามเซลล์ A10:Q15 ค่ะ

Code ด้านล่างนี้ควรปรับอย่างไรดีคะ

Code: Select all

Sub MainCode()
    Application.ScreenUpdating = False
        Call InvNo
        Call DD
        Call SupplierID
        Call MMM
        Call YY
    Application.ScreenUpdating = True
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub SupplierID()
    If Sheets("Report").Range("c4") = "" Then Exit Sub
    Sheets("Report").Range("A10:Q1000").ClearContents
    Sheets("Database").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("C3:C4"), CopyToRange:=Range("A10"), Unique:=False
End Sub

[suka]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub SupplierID()
If Sheets("Report").Range("c4") = "" Then Exit Sub
Sheets("Report").Range("A10:Q1000").ClearContents
Sheets("Database").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("C3:C4"), CopyToRange:=Range("A10"), Unique:=False
End Sub

ขอบคุณค่ะอาจารย์ ปรับครบทุก Code แล้วค่ะ

Code: Select all

Sub MainCode()
    Application.ScreenUpdating = False
        Call InvNo
        Call DD
        Call SupplierID
        Call MMM
        Call YY
    Application.ScreenUpdating = True
End Sub

อาจารย์คะ ต้องการปรับ MainCode เมื่อ Run Code แล้วให้ Code MMM และ Code YY
ใช้ร่วมกับ Code InvNo , Code DD , Code SupplierID โค๊ดใดๆที่ตรงกับเซลล์ A3:C4 ชีท Report ไม่เป็นค่าว่างให้ดึงข้อมูลที่ค่าในชีท Database ตรงกันมาวางที่ชีท Report เซลล์ A10:Q1000 ค่ะ

MainCode ตัวอย่างด้านบนควรปรับอย่างไรคะ

[snasui]

เขียนมาเองก่อน ติดแล้วค่อยถามกัน

การปรับ Code ไม่จำเพาะว่าปรับเฉพาะที่ MainCode หรือที่หนึ่งที่ใด เพราะสามารถที่จะปรับที่ใดก็ได้ทั้งนั้น ขอทำงานได้ตามต้องการครับ

[suka]

อาจารย์คะ ลองปรับ Code แบบนี้ดึงได้แต่ Code MMM ข้อมูลของเดือนมา ยังไม่ได้ที่ต้องการค่ะ

Code: Select all

Sub MainCode()
    Application.ScreenUpdating = False
    With Sheets("Report")
        If .Range("A4") <> "" Then
            Call InvNo
        End If
        If .Range("B4") <> "" Then
            Call DD
        End If
        If .Range("C4") <> "" Then
            Call SupplierID
        End If
        If .Range("E4") <> "" Then
            Call MMM
        End If
        If .Range("F4") <> "" Then
            Call YY
        End If
    End With
    Application.ScreenUpdating = True
End Sub

[snasui]

ผมคิดว่ากำลังจะเขียน Code ให้ซับซ้อนโดยไม่จำเป็น เพื่อให้ง่าย ปรับ Database ให้แสดงเดือน และ ปี ออกมาเลย Code ทั้งหมดควรจะเหลือแค่ Code เดียวเท่านั้นและทำงานได้ทุกเงื่อนไข ไม่จำเป็นต้องแยกออกเป็นหลาย Code เช่นที่ถามมานี้

ในชีท Database คอลัมน์ P หาค่าเดือนจากคอลัมน์ A เช่น

P2 เขียนสูตรเป็น

=Month(A2)

คิดว่าคอลัมน์ Q คงจะหาค่าปีออกมาได้เองโดยใช้ฟังก์ชั่น Year

ในชีท Report เซลล์ E4:F5 ปรับกลับมาให้เหมือนเดิม คือมีหัว Field ให้เรียบร้อย จากนั้นปรับ Code เหลือ Code เดียว

[suka]

ขอบพระคุณอาจารย์มากๆเลยค่ะ ปรับค่าเดือนและปีที่ชีท Database แล้วใช้ Code ด้านล่างนี้ สามารถดึงข้อมูลมาได้ตรงตามต้องการทุกเงื่อนไขแล้วค่ะ

Code: Select all

Sub InvNo()
    Sheets("Report").Range("A10:Q1000").ClearContents
    Sheets("Database").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("A3:F4"), CopyToRange:=Range("A10"), Unique:=False
End Sub

[suka]

ขอเรียนถามเพิ่มเงื่อนไข การดึงข้อมูลตามวันที่ ที่ระบุวันเริ่มต้นที่เซลล์ B4 จนถึงวันที่ตามเซลล์ C4
ตัวอย่างไฟล์แนบชีท Report B4:C4 ใส่วัน 18/9/2015 - 21/9/2015 ค่าที่ต้องการที่เซลล์ A10:Q27 ค่ะ

Code Run แล้วฟ้องตามรูปค่ะ Code ด้านล่างนี้ควรปรับอย่างไรคะ

Code: Select all

Sub InvNo()
    Set i = (Sheets("Report").Range("B4") = "Start" + .Range("C4") = "End")
    If Sheets("Report").Range(i) = "" Then Exit Sub
    Sheets("Report").Range("A10:Q1000").ClearContents
    Sheets("Database").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("A3:F4"), CopyToRange:=Range("A10"), Unique:=False
End Sub

[niwat2811]

ลองแบบนี้ว่าใช้ได้ตามต้องการไหมครับ

Code: Select all

Sub InvNo()
Dim lngStart As Long, lngEnd As Long, lr As Long
    If Range("B4") = "" Or Range("C4") = "" Then
        Exit Sub
        Else
            Range("A10:Q1000").ClearContents
            lngStart = Range("B4").Value
            lngEnd = Range("C4").Value
            With Sheets("Database")
            lr = .Range("A" & Rows.Count).End(xlUp).Row
                .Range("A1:A" & lr).AutoFilter field:=1, _
                    Criteria1:=">=" & lngStart, _
                    Operator:=xlAnd, _
                    Criteria2:="<=" & lngEnd
                .Range("A1:Q" & lr).SpecialCells(xlCellTypeVisible).Copy
                Sheets("Report").Range("A10").PasteSpecial
                .AutoFilterMode = False
                .Application.CutCopyMode = False
            End With
    End If
End Sub