Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://www.snasui.com/

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

https://www.snasui.com/viewtopic.php?t=1513

Page 1 of 2

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

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

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

Posted: Wed Sep 07, 2011 2:40 pm
by snasui
:D ใน Data > Validation แทนที่จะคีย์ลงไปเองให้กดแป้น F3 โปรแกรมจะ Pop-up รายชื่อที่กำหนดไว้มาให้เลือก เมื่อเลือกมาแล้วโปรแกรมจะเติมเครื่องหมาย = มาให้ ถ้าไม่ใส่เครื่องหมาย = จะกลายเป็นว่าเราคีย์ค่าที่ให้เลือกได้เข้าไปเอง ซึ่งอาจจะผิดไปจากที่ต้องการให้อ้างอิงจากการให้ชื่อช่วงเซลล์เอาไว้ก่อน

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

Posted: Wed Sep 07, 2011 3:50 pm
by yodpao.b
ขอบคุณครับ เรียบร้อยแล้วครับ แค่เครื่องหมายเท่ากับ ดันลืมซะได้

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

Posted: Fri Sep 16, 2011 1:05 pm
by yodpao.b
yodpao.b wrote:ทำตามตัวอย่างลิงค์http://snasui.blogspot.com/2011/06/vba_26.html ที่อาจาร์ยให้มา

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

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

Posted: Fri Sep 16, 2011 1:37 pm
by snasui
:D ปิดไฟล์ไปก่อนแล้วเปิดขึ้นมาใหม่ ปรับ 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 สำหรับบรรทัดที่ปรับปรุงใหม่แล้วครับ

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

Posted: Fri Sep 16, 2011 2:24 pm
by yodpao.b
สุดยอดอาจารย์
ผมไม่อยากหยุดงานเลย กำลังมัน
กลับไปบ้านผมจะลองเพิ่มในฐานข้อมูล และเพิ่มคอลัมน์ใน report ดู
และจะดูว่าสามารถเลียนแบบ code ที่อาจารย์ให้มาได้ไหม
ในหน้านี้ หมดคำถาม

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

Posted: Mon Sep 19, 2011 10:41 am
by yodpao.b
จากการใช้ตัวกรองที่ อาจารย์ให้มา ดีมากครับ ผมจะนำไปใช้สำหรับการค้นหา
หัวคอลัม ที่ปกตินำไปใช้ในตัวกรองส่วนใหญ่เป็นลัษณะดังรูปที่ 1 คือมีบรรทัดเดียว
untitled123.GIF
ถามว่าถ้าเป็นลัษณะดังรูปที่ 2 หัวคอลัมมันมี2บรรทัด ยังสามารถที่จะใช้ตัวกรองได้ไหม

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

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

Posted: Mon Sep 19, 2011 1:14 pm
by snasui
:D สามารถทำได้ครับ ลองทำมาดูก่อน ติดตรงไหนสามารถถามมาได้เรื่อย ๆ ครับ

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

Posted: Mon Sep 19, 2011 2:51 pm
by yodpao.b
รบกวนอีกครั้งครับ
ใน sheets("Report") เซล F3 เป็นตัวสั่งให้ไปค้นหาชื่อในเชลนี้
- ปัญหาคือที่วงกลมไว้มันขึ้นวันผิด ที่ถูกต้องมันต้องไปเอาค่าในคอลัม M ใน sheets("ฐานข้อมูลล่วงเวลา")
- พอเรียกหมายเลขอื่นที่นี้ขึ้นมั่วไปหมดเลย
งงมากครับทั้งที่ลองเพิ่มแถวแก้โค้ด ก็ไม่มีปัญหา แต่พอกลับไฟล์จริงกลับทำไม่ได้
อาจารย์ช่วยตรวจดูโคด้ให้หน่อยครับ
untitled.GIF

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

Posted: Mon Sep 19, 2011 7:39 pm
by snasui
:D ลองทดสอบ 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

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

Posted: Tue Sep 20, 2011 8:02 am
by yodpao.b
ได้แล้วครับอาจาร์ยขอบคุณมากครับ code นี้มีความจำเป็นมากคือต้องใช้บ่อยในการค้นหาข้อมูลที่ที่ต้องการบางคอลัม
ไว้ผมจะเขียนมาถามความหมายของแต่ละบรรทัดนะครับ

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

Posted: Thu Sep 22, 2011 1:35 pm
by 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

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

Posted: Thu Sep 22, 2011 7:20 pm
by snasui
:D เนื่องจากที่ถามมานั้น มีการแบ่ง 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 ในลักษณะสลับแกนตั้งเป็นแกนนอน

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

Posted: Fri Sep 23, 2011 12:05 pm
by 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

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

Posted: Fri Sep 23, 2011 12:14 pm
by snasui
:D Code ที่โพสต์มายังไม่ได้ลองปรับมาเลยครับ ช่วยปรับมาก่อนครับ

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

Posted: Fri Sep 23, 2011 12:29 pm
by yodpao.b
ถ้าอย่างนั้นผมขออนุญาติใช้แบบจริงนะครับ อาจารย์ทดลองได้จาก Sheet "Report" ปุ่ม "เรียกฟอร์ม"
ไฟล์นี้ชื่อ OT_New ต้องการเพิ่มข้อแม้ในส่วนของเดือน ข้อมูลอยู่ที่ Sheet"ฐานข้อมูลล่วงเวลา" คอลัม x
ส่วนข้อแม้อยู่ที่ Sheet "Report" เชล E3

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

Posted: Fri Sep 23, 2011 12:34 pm
by yodpao.b
ขอโทษครับลืมบอกไป
ข้อแม้ทั้ง 2 คือ เลขประจำตัวและเดือนต้องสัมพันกัน

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

Posted: Fri Sep 23, 2011 1:13 pm
by snasui
:roll: ไฟล์ที่แนบมายังไม่ได้ปรับ 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

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

Posted: Fri Sep 23, 2011 1:33 pm
by yodpao.b

Code: Select all

 If r = Worksheets("Report").Range("F3") and r.offset(0,100) = Worksheets("Report").Range("F1000") Then
code นี้เกี่ยวกับเดือนเหรอครับ ลอง run แล้วไม่มีอะไรเกิดขึ้น

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

Posted: Fri Sep 23, 2011 3:21 pm
by snasui
yodpao.b wrote:code นี้เกี่ยวกับเดือนเหรอครับ
ไม่ใช่ครับ
yodpao.b wrote:ลอง run แล้วไม่มีอะไรเกิดขึ้น
ควรจะเป็นเช่นนั้นครับ

ที่เขียนมาให้นั้นเป็นตัวอย่างการปรับเงื่อนไขครับ :aru: ข้างบนก็บอกไว้แล้วครับ ส่วนเงื่อนไขอยู่เซลล์ไหนก็ต้องไปอ้างอิงให้ถูกครับ
All times are UTC+07:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited