สอบถามการใช้ตัวกรองจากVBA

[yodpao.b]

ทำตามตัวอย่างลิงค์http://snasui.blogspot.com/2011/06/vba_26.html ที่อาจาร์ยให้มาแต่มีปัญหาที่
Cell C2 sheets Report ทำอย่างอาจาย์ไม่ได้ ช่วยดูให้หน่อยครับ

[snasui]

ใน Data > Validation แทนที่จะคีย์ลงไปเองให้กดแป้น F3 โปรแกรมจะ Pop-up รายชื่อที่กำหนดไว้มาให้เลือก เมื่อเลือกมาแล้วโปรแกรมจะเติมเครื่องหมาย = มาให้ ถ้าไม่ใส่เครื่องหมาย = จะกลายเป็นว่าเราคีย์ค่าที่ให้เลือกได้เข้าไปเอง ซึ่งอาจจะผิดไปจากที่ต้องการให้อ้างอิงจากการให้ชื่อช่วงเซลล์เอาไว้ก่อน

[yodpao.b]

ขอบคุณครับ เรียบร้อยแล้วครับ แค่เครื่องหมายเท่ากับ ดันลืมซะได้

[yodpao.b]

ทำตามตัวอย่างลิงค์http://snasui.blogspot.com/2011/06/vba_26.html ที่อาจาร์ยให้มา

ผมลองนำมาทำแล้วลองเล่นดู เวลาดลิกเลือกข้อมูลที่เซล "E2" Sheet Report ไม่เห็นมันทำงานอะไรเลย
อาจาร์ยช่วยดูหน่อยครับ

[snasui]

ปิดไฟล์ไปก่อนแล้วเปิดขึ้นมาใหม่ ปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Option Explicit
Option Base 1

Sub ShowEmp()
Dim a() As Variant, lng As Long
Dim r As Range, rAll As Range
Dim rt As Range, rl As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
rl = Rows.Count
With Worksheets("Database")
    Set rAll = .Range("F2", .Range("F" & rl).End(xlUp))
End With
For Each r In rAll
    If r = Worksheets("Report").Range("E2") Then
        lng = lng + 1
        ReDim Preserve a(5, lng)
        a(1, lng) = lng
        a(2, lng) = r.Offset(0, -5)
        a(3, lng) = r.Offset(0, -4)
        a(4, lng) = r.Offset(0, -3)
        a(5, lng) = r.Offset(0, -2)
    End If
Next r
If lng > 0 Then
    With Worksheets("Report")
        Set rt = .Range("A5", .Range("E" & lng - 1 + 5))
        If .Range("A5") <> "" Then 'Check if isblank
             .Range("A5", .Range("A" & rl).End(xlUp).Offset(0, 4)).ClearContents
        End If
        .Range("A5:E5").Copy
        rt.PasteSpecial xlPasteFormats
        rt = Application.Transpose(a)
        .Range("B5", .Range("B" & rl).End(xlUp)).NumberFormat = "000000"
        .Range(.Range("A4").End(xlDown).Offset(1, 0), .Range("E" & rl)).Clear 'Change new start cell
        .Range("E2").Activate
    End With
Else
    MsgBox "Data not found."
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

ผมเขียน Note ไว้ใน Code สำหรับบรรทัดที่ปรับปรุงใหม่แล้วครับ

[yodpao.b]

สุดยอดอาจารย์
ผมไม่อยากหยุดงานเลย กำลังมัน
กลับไปบ้านผมจะลองเพิ่มในฐานข้อมูล และเพิ่มคอลัมน์ใน report ดู
และจะดูว่าสามารถเลียนแบบ code ที่อาจารย์ให้มาได้ไหม
ในหน้านี้ หมดคำถาม

[yodpao.b]

จากการใช้ตัวกรองที่ อาจารย์ให้มา ดีมากครับ ผมจะนำไปใช้สำหรับการค้นหา
หัวคอลัม ที่ปกตินำไปใช้ในตัวกรองส่วนใหญ่เป็นลัษณะดังรูปที่ 1 คือมีบรรทัดเดียว

untitled123.GIF

ถามว่าถ้าเป็นลัษณะดังรูปที่ 2 หัวคอลัมมันมี2บรรทัด ยังสามารถที่จะใช้ตัวกรองได้ไหม

ตัวกรองในที่นี้ หมายถึงการเขียน Code vba ค้นหา

untitled145.GIF

[snasui]

สามารถทำได้ครับ ลองทำมาดูก่อน ติดตรงไหนสามารถถามมาได้เรื่อย ๆ ครับ

[yodpao.b]

รบกวนอีกครั้งครับ
ใน sheets("Report") เซล F3 เป็นตัวสั่งให้ไปค้นหาชื่อในเชลนี้
- ปัญหาคือที่วงกลมไว้มันขึ้นวันผิด ที่ถูกต้องมันต้องไปเอาค่าในคอลัม M ใน sheets("ฐานข้อมูลล่วงเวลา")
- พอเรียกหมายเลขอื่นที่นี้ขึ้นมั่วไปหมดเลย
งงมากครับทั้งที่ลองเพิ่มแถวแก้โค้ด ก็ไม่มีปัญหา แต่พอกลับไฟล์จริงกลับทำไม่ได้
อาจารย์ช่วยตรวจดูโคด้ให้หน่อยครับ

untitled.GIF

[snasui]

ลองทดสอบ Code ตามด้านล่างครับ

Code: Select all

Option Explicit
Option Base 1

Sub ShowEmp()
Dim a() As Variant, lng As Long
Dim r As Range, rAll As Range
Dim rt As Range, rl As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
rl = Rows.Count
With Worksheets("ฐานข้อมูลล่วงเวลา")
    Set rAll = .Range("B7", .Range("B" & rl).End(xlUp))
End With
For Each r In rAll
    If r = Worksheets("Report").Range("F3") Then
        lng = lng + 1
        ReDim Preserve a(13, lng)
        a(1, lng) = r.Offset(0, 11)
        a(2, lng) = r.Offset(0, 4)
        a(3, lng) = r.Offset(0, 6)
        a(4, lng) = r.Offset(0, 7)
        a(5, lng) = r.Offset(0, 13)
        a(6, lng) = r.Offset(0, 14)
        a(7, lng) = r.Offset(0, 15)
        a(8, lng) = r.Offset(0, 16)
        a(9, lng) = r.Offset(0, 17)
        a(10, lng) = r.Offset(0, 18)
        a(11, lng) = r.Offset(0, 19)
        a(12, lng) = r.Offset(0, 20)
        'a(13, lng) = r.Offset(0, 22)
    End If
Next r
If lng > 0 Then
    With Worksheets("Report")
        Set rt = .Range("C11", .Range("N" & lng - 1 + 11))
        If .Range("C11") <> "" Then 'Check if isblank
             .Range("C11", .Range("C" & rl).End(xlUp).Offset(0, 12)).ClearContents
        End If
        .Range("C11:N11").Copy
        rt.PasteSpecial xlPasteFormats
        rt = Application.Transpose(a)
        '.Range("B5", .Range("B" & rl).End(xlUp)).NumberFormat = "000000"
        .Range(.Range("C10").End(xlDown).Offset(1, 0), .Range("N" & rl)).Clear 'Change new start cell
'        .Range("F3").Select
    End With
Else
    MsgBox "Data not found."
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

[yodpao.b]

ได้แล้วครับอาจาร์ยขอบคุณมากครับ code นี้มีความจำเป็นมากคือต้องใช้บ่อยในการค้นหาข้อมูลที่ที่ต้องการบางคอลัม
ไว้ผมจะเขียนมาถามความหมายของแต่ละบรรทัดนะครับ

[yodpao.b]

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

ขอบคุณมากครับ

Code: Select all

Application.EnableEvents = False
Application.ScreenUpdating = False

Code: Select all

rl = Rows.Count
With Worksheets("°Ò¹¢éÍÁÙÅÅèǧàÇÅÒ")
    Set rAll = .Range("B7", .Range("B" & rl).End(xlUp))
End Wit

Code: Select all

For Each r In rAll
    If r = Worksheets("Report").Range("F3") Then
        lng = lng + 1
        ReDim Preserve a(13, lng)
        a(1, lng) = r.Offset(0, 11)
        a(11, lng) = r.Offset(0, 19)
        a(12, lng) = r.Offset(0, 20)
    End If

Code: Select all

Next r
If lng > 0 Then
    With Worksheets("Report")
        Set rt = .Range("C11", .Range("N" & lng - 1 + 11))
        If .Range("C11") <> "" Then 'Check if isblank
             .Range("C11", .Range("C" & rl).End(xlUp).Offset(0, 12)).ClearContents
        End If

Code: Select all

        .Range("C11:N11").Copy
        rt.PasteSpecial xlPasteFormats
        rt = Application.Transpose(a)
        .Range(.Range("C10").End(xlDown).Offset(1, 0), .Range("N" & rl)).Clear 

[snasui]

เนื่องจากที่ถามมานั้น มีการแบ่ง Code มาในลักษณะขาดบ้างเกินบ้าง หากอธิบายไปตามนั้นอาจจะทำให้สับสนได้ ผมจึงนำมาอธิบายใหม่ตามด้านล่าง

Code: Select all

Application.EnableEvents = False

เป็นการกำหนดให้โปรแกรมไม่ Run Event ที่เป็นผลจากการ Run Code นี้

Code: Select all

Application.ScreenUpdating = False

เป็นการกำหนดให้หน้าจอไม่วูบวาบขณะ Run Code

Code: Select all

rl = Rows.Count

เป็นการกำหนดค่าให้กับตัวแปร rl ว่าให้มีค่าเท่ากับจำนวนบรรทัดทั้งหมด

Code: Select all

With Worksheets("ฐานข้อมูลล่วงเวลา")
    Set rAll = .Range("B7", .Range("B" & rl).End(xlUp))
End With

เป็นการกำหนดช่วงข้อมูลให้กับตัวแปร rAll

Code: Select all

For Each r In rAll
    If r = Worksheets("Report").Range("F3") Then
        lng = lng + 1
        ReDim Preserve a(13, lng)
        a(1, lng) = r.Offset(0, 11)
        a(2, lng) = r.Offset(0, 4)
        a(3, lng) = r.Offset(0, 6)
        a(4, lng) = r.Offset(0, 7)
        a(5, lng) = r.Offset(0, 13)
        a(6, lng) = r.Offset(0, 14)
        a(7, lng) = r.Offset(0, 15)
        a(8, lng) = r.Offset(0, 16)
        a(9, lng) = r.Offset(0, 17)
        a(10, lng) = r.Offset(0, 18)
        a(11, lng) = r.Offset(0, 19)
        a(12, lng) = r.Offset(0, 20)
        'a(13, lng) = r.Offset(0, 22)
    End If
Next r

เป็นการกำหนดค่าให้กับตัวแปร Array a ซึ่งต้องเข้าใจ Array ก่อนถึงจะทำความเข้าใจ Code นี้ได้ สำหรับ Array นี้เป็นแบบ 2 มิติคือมีทั้ง Row และ Column

จากตัวอย่างด้านบน a(1, lng) = r.Offset(0, 11) หมายถึง ให้ Array a แถวที่หนึ่ง คอลัมน์ที่ได้จากค่า lng มีค่าเท่ากับ ค่าที่ถัดไปจากตัวแปร r ทางด้านขวา 11 คอลัมน์

Code: Select all

If lng > 0 Then
    With Worksheets("Report")
        Set rt = .Range("C11", .Range("N" & lng - 1 + 11))
        If .Range("C11") <> "" Then 'Check if isblank
             .Range("C11", .Range("C" & rl).End(xlUp).Offset(0, 12)).ClearContents
        End If
        .Range("C11:N11").Copy
        rt.PasteSpecial xlPasteFormats
        rt = Application.Transpose(a)
        '.Range("B5", .Range("B" & rl).End(xlUp)).NumberFormat = "000000"
        .Range(.Range("C10").End(xlDown).Offset(1, 0), .Range("N" & rl)).Clear 'Change new start cell
'        .Range("F3").Select
    End With
Else
    MsgBox "Data not found."
End If

หมายถึงให้ดูว่าตัวแปร lng มีค่ามากกว่า 0 หรือไม่ หากมากกว่า 0 ก็ให้ Run Statement ด้านล่าง

Code: Select all

With Worksheets("Report")
        Set rt = .Range("C11", .Range("N" & lng - 1 + 11))
        If .Range("C11") <> "" Then 'Check if isblank
             .Range("C11", .Range("C" & rl).End(xlUp).Offset(0, 12)).ClearContents
        End If
        .Range("C11:N11").Copy
        rt.PasteSpecial xlPasteFormats
        rt = Application.Transpose(a)
        '.Range("B5", .Range("B" & rl).End(xlUp)).NumberFormat = "000000"
        .Range(.Range("C10").End(xlDown).Offset(1, 0), .Range("N" & rl)).Clear 'Change new start cell
'        .Range("F3").Select
    End With

แต่หากไม่มากกว่า 0 ให้แสดงข้อความ Data not found

จาก Code ด้านบนหลัก ๆ จะเป็นการ

1. กำหนดค่าให้กับตัวแปร rt และตรวจสอบว่า C11 เป็นค่าว่างหรือไม่ หากเป็นค่าว่างก็ให้ทำการ Cleare ช่วงข้อมูล นับจาก C11 โดยมีความสูงเท่าที่มีข้อมูลและความกว้าง 12 คอลัมน์

2. ให้ Copy ค่าในช่วง C11:N11 แล้ววางเฉพาะ Format ให้กับตัวแปร rt

3. ให้ตัวแปร rt มีค่าเท่ากับค่าของ Array a ในลักษณะสลับแกนตั้งเป็นแกนนอน

[yodpao.b]

Code: Select all

Option Explicit
Option Base 1

Sub ShowEmp()
Dim a() As Variant, lng As Long
Dim r As Range, rAll As Range
Dim rt As Range, rl As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
rl = Rows.Count
With Worksheets("ฐานข้อมูลล่วงเวลา")
    Set rAll = .Range("B7", .Range("B" & rl).End(xlUp))
End With
For Each r In rAll
    If r = Worksheets("Report").Range("F3") Then
        lng = lng + 1
        ReDim Preserve a(13, lng)
        a(1, lng) = r.Offset(0, 11)
        a(2, lng) = r.Offset(0, 4)
        a(3, lng) = r.Offset(0, 6)
        a(4, lng) = r.Offset(0, 7)
        a(5, lng) = r.Offset(0, 13)
        a(6, lng) = r.Offset(0, 14)
        a(7, lng) = r.Offset(0, 15)
        a(8, lng) = r.Offset(0, 16)
        a(9, lng) = r.Offset(0, 17)
        a(10, lng) = r.Offset(0, 18)
        a(11, lng) = r.Offset(0, 19)
        a(12, lng) = r.Offset(0, 20)
        'a(13, lng) = r.Offset(0, 22)
    End If
Next r
If lng > 0 Then
    With Worksheets("Report")
        Set rt = .Range("C11", .Range("N" & lng - 1 + 11))
        If .Range("C11") <> "" Then 'Check if isblank
             .Range("C11", .Range("C" & rl).End(xlUp).Offset(0, 12)).ClearContents
        End If
        .Range("C11:N11").Copy
        rt.PasteSpecial xlPasteFormats
        rt = Application.Transpose(a)
        '.Range("B5", .Range("B" & rl).End(xlUp)).NumberFormat = "000000"
        .Range(.Range("C10").End(xlDown).Offset(1, 0), .Range("N" & rl)).Clear 'Change new start cell
'        .Range("F3").Select
    End With
Else
    MsgBox "Data not found."
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

จาก code ทีอาจาร์ยให้มา ข้อแม้อยู่ที่ F3คือเลขประจำตัว
อยากเพิ่มข้อแม้อีกคือเดือนอยู่ที่ E3 ชีตReport
จะเขีนยอย่างไรครับ

รูป

untitled.GIF

[snasui]

Code ที่โพสต์มายังไม่ได้ลองปรับมาเลยครับ ช่วยปรับมาก่อนครับ

[yodpao.b]

ถ้าอย่างนั้นผมขออนุญาติใช้แบบจริงนะครับ อาจารย์ทดลองได้จาก Sheet "Report" ปุ่ม "เรียกฟอร์ม"
ไฟล์นี้ชื่อ OT_New ต้องการเพิ่มข้อแม้ในส่วนของเดือน ข้อมูลอยู่ที่ Sheet"ฐานข้อมูลล่วงเวลา" คอลัม x
ส่วนข้อแม้อยู่ที่ Sheet "Report" เชล E3

[yodpao.b]

ขอโทษครับลืมบอกไป
ข้อแม้ทั้ง 2 คือ เลขประจำตัวและเดือนต้องสัมพันกัน

[snasui]

ไฟล์ที่แนบมายังไม่ได้ปรับ Code ครับ

Code ที่จะปรับคือด้านล่าง

Code: Select all

  If r = Worksheets("Report").Range("F3") Then

หากมีหลายเงื่อนไขก็ปรับเพิ่มเข้าไปครับ ตัวอย่างเช่นตามด้านล่างเป็นต้น

Code: Select all

  If r = Worksheets("Report").Range("F3") and r.offset(0,100) = Worksheets("Report").Range("F1000") Then

[yodpao.b]

Code: Select all

 If r = Worksheets("Report").Range("F3") and r.offset(0,100) = Worksheets("Report").Range("F1000") Then

code นี้เกี่ยวกับเดือนเหรอครับ ลอง run แล้วไม่มีอะไรเกิดขึ้น

[snasui]

code นี้เกี่ยวกับเดือนเหรอครับ

ไม่ใช่ครับ

ลอง run แล้วไม่มีอะไรเกิดขึ้น

ควรจะเป็นเช่นนั้นครับ

ที่เขียนมาให้นั้นเป็นตัวอย่างการปรับเงื่อนไขครับ ข้างบนก็บอกไว้แล้วครับ ส่วนเงื่อนไขอยู่เซลล์ไหนก็ต้องไปอ้างอิงให้ถูกครับ