:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

รบกวนตรวจ Code ให้ด้วยครับ

Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่

Post a reply


This question is a means of preventing automated form submissions by spambots.
Smilies
:D :thup: :cp: :flw: :rz: :sg: :tt: :) ;) :( :o :shock: :? 8-) :lol: :x :P :oops: :cry: :evil: :twisted: :roll: :!: :?: :idea: :arrow: :ard: :arl: :aru: :| :mrgreen: :geek: :ugeek:

BBCode is ON
[img] is ON
[url] is ON
Smilies are ON

Topic review
   

Expand view Topic review: รบกวนตรวจ Code ให้ด้วยครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

#42

by rich37 » Wed Apr 12, 2017 7:16 pm

เผื่อบางท่านจะเอาไปปรับใช้กับงานนะครับ

Code: Select all

Option Explicit 
Private Sub TextBox6_Change() 
    Dim x, i As Long, ii As Long, iii As Integer, e As Long 
    x = [_Data] 
    With ListBox1 
        If TextBox6.Value = vbNullString Then 
            .List = x 
        Else 
            e = IIf(OptionButton1, 1, 4) 
            For i = 1 To UBound(x, 1) 
                If LCase(x(i, e)) Like LCase(TextBox6.Value) & "*" Then 
                    .AddItem 
                    For ii = 1 To 9 
                        .List(.ListCount - 1, ii - 1) = x(i, ii) 
                    Next 
                End If 
            Next 
        End If 
    End With 
End Sub 

Re: รบกวนตรวจ Code ให้ด้วยครับ

#41

by rich37 » Sat Apr 08, 2017 5:16 pm

แสดงการเลือก Code
Attachments
111.jpg
111.jpg (282.19 KiB) Viewed 24 times

Re: รบกวนตรวจ Code ให้ด้วยครับ

#40

by rich37 » Thu Apr 06, 2017 10:27 am

สอบถามการปรับCodeด้านล่าง โดยการเลือก Option Button หากเลือก Option Button1 ให้ลือก Codeนี้

Code: Select all

Private Sub TextBox6_Change()
   Dim x, i As Long, ii As Long, iii As Integer
    x = [_Data]
    With ListBox1
        If TextBox6 = "" Then
            .RowSource = "_Data"
        Else
            .RowSource = ""
            For i = 1 To UBound(x, 1)
                If LCase(x(i, 1)) Like LCase(TextBox6) & "*" Then
                    For ii = 1 To 9
                        .AddItem
                        .List(iii, ii - 1) = x(i, ii)
                    Next
                    iii = iii + 1
                End If
            Next
        End If
    End With
End Sub
หากเลือก Option Button2 ให้ลือก Codeนี้

Code: Select all

Private Sub TextBox6_Change()
   Dim x, i As Long, ii As Long, iii As Integer
    x = [_Data]
    With ListBox1
        If TextBox6 = "" Then
            .RowSource = "_Data"
        Else
            .RowSource = ""
            For i = 1 To UBound(x, 1)
                If LCase(x(i, 4)) Like LCase(TextBox6) & "*" Then
                    For ii = 1 To 9
                        .AddItem
                        .List(iii, ii - 1) = x(i, ii)
                    Next
                    iii = iii + 1
                End If
            Next
        End If
    End With
End Sub

Re: รบกวนตรวจ Code ให้ด้วยครับ

#39

by rich37 » Thu Apr 06, 2017 8:14 am

snasui wrote: แต่หากจะให้แสดงเฉพาะค่าที่คล้ายกับค่าที่ต้องการค้นหา แนวทางนี้มาผิดทางครับ การทำเช่นนั้นควรจะ Loop จาก Database มาวางใน ListBox ไม่ใช่ให้เลือกรายการใน ListBox ที่ตรงกันกับค่าที่ต้องการค้นหาเช่น Code ด้านบน

การแสดงค่าใน ListBox ควรจะนำค่าจากต้นทางมาแสดง ไม่ใช่นำค่าใน ListBox เองมาแสดง เพราะหากทำเช่นนั้น เมื่อมีการค้นหาไปรอบนึงแล้ว ListBoxt จะเหลือเพียงบางจำนวนที่ตรงกับเงื่อนไขในครั้งนั้น หากคีย์ค้นหาครั้งต่อไปก็จะไม่เหลือรายการที่ตรงกับค่าที่ค้นหาอีก เช่นนี้เป็นต้นครับ
ผมได้ทำการปรับ Code เป็นตัวด้านล่างนี้

Code: Select all

Private Sub TextBox6_Change()
   Dim x, i As Long, ii As Long, iii As Integer
    x = [_Data]
    With ListBox1
        If TextBox6 = "" Then
            .RowSource = "_Data"
        Else
            .RowSource = ""
            For i = 1 To UBound(x, 1)
                If LCase(x(i, 1)) Like LCase(TextBox6) & "*" Then
                    For ii = 1 To 9
                        .AddItem
                        .List(iii, ii - 1) = x(i, ii)
                    Next
                    iii = iii + 1
                End If
            Next
        End If
    End With
End Sub
สามารถค้นหาได้ตามต้องการแต่ ปัญหาที่ตามมาคือ จากที่สามารถแก้ไขรายการจากการเลือกรายการในListbox ได้ หลังจากใส่ Code แล้วเกิด Error 1004 ตามรูปนี้ครับ รบกวนช่วยดูให้หน่อยนะครับ

Code: Select all

Private Sub CommandButton4_Click() ' edit
Dim sonsat As Long
If ListBox1.ListIndex = -1 Then
        MsgBox "คุณยังไม่ได้ใส่ข้อมูล", vbInformation, "ระบบค้นหาสำนวน"
        Me.TextBox6.SetFocus
Exit Sub
End If
    lastrow = Sheets("Database").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Database").Range("A2:I" & lastrow).Find(What:=ListBox1.Text, LookIn:=xlValues, LookAt:=xlWhole).Activate
    sonsat = ActiveCell.Row
        Cells(sonsat, 1) = Me.TextBox1.Value
        Cells(sonsat, 2) = Me.TextBox2.Value
        Cells(sonsat, 3) = Me.TextBox3.Value
        Cells(sonsat, 4) = Me.TextBox4.Value
        Cells(sonsat, 5) = Me.ComboBox3.Value
        Cells(sonsat, 6) = Me.ComboBox4.Value
        Cells(sonsat, 7) = Me.ComboBox1.Value
        Cells(sonsat, 8) = Me.ComboBox2.Value
        Cells(sonsat, 9) = Me.TextBox5.Value
        Me.TextBox6.SetFocus
        MsgBox "แก้ไขข้อมูลเรียบร้อย", vbInformation, "ระบบค้นหาสำนวน"
        ListBox1.List = Sheets("Database").Range("A2:I" & Sheets("Database").Cells(Rows.Count, 1).End(xlUp).Row).Value
        Me.TextBox7.Value = ListBox1.ListCount
        ActiveWorkbook.Save
End Sub
Attachments
111.jpg
111.jpg (299.23 KiB) Viewed 158 times

Re: รบกวนตรวจ Code ให้ด้วยครับ

#38

by rich37 » Wed Apr 05, 2017 11:55 pm

puriwutpokin wrote:ส่งไม่ผ่านครับ ใช้มือถือต่อเน็ตสัญญาณอ่อน ส่งผ่านแล้วครับดูที่กระทู้บนครับ
ขอบคุณครับ โหลดมาดูแล้วได้ผลแบบไหนจะแจ้งให้ทราบอีกครั้งหนึ่งครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

#37

by puriwutpokin » Wed Apr 05, 2017 11:40 pm

ส่งไม่ผ่านครับ ใช้มือถือต่อเน็ตสัญญาณอ่อน ส่งผ่านแล้วครับดูที่กระทู้บนครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

#36

by rich37 » Wed Apr 05, 2017 11:33 pm

puriwutpokin wrote:ผมลองทำแบบไฟล์เก่าของคุณ rich37 ได้ประมาณนี้ตามไฟล์แนบครับ ใช้แบบดั่งเดิม
รบกวนขอดูด้วยครับผม ขอบคุณครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

#35

by puriwutpokin » Wed Apr 05, 2017 11:20 pm

ผมลองทำแบบไฟล์เก่าของคุณ rich37 ได้ประมาณนี้ตามไฟล์แนบครับ ใช้แบบดั่งเดิม
Attachments
ค้นหาสำนวนEnd.rar
(456.38 KiB) Downloaded 17 times

Re: รบกวนตรวจ Code ให้ด้วยครับ

#34

by rich37 » Wed Apr 05, 2017 9:29 pm

:thup: ขอบคุณครับ

Re: รบกวนตรวจ Code ให้ด้วยครับ

#33

by snasui » Wed Apr 05, 2017 9:24 pm

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

Code ที่ผมโพสต์ไปนั้นไม่ใช่เป็นการตอบเพื่อแก้ในส่วนที่เป็นปัญหา เพียงแต่ตอบว่า หากต้องการจะหาแบบตรงตัวจะต้องเขียนเช่นไร เป็นเพียงใจความประกอบ ไม่ใช่ใจความหลักครับ ใจความหลักคือให้ Loop จาก Database มาใช้ใน ListBox ครับ

หลักการทำงานลักษณะนี้มีลำดับคือ

เมื่อมีการเปลี่ยนค่าใน TextBox ให้ลบค่าใน ListBox ทิ้งก่อน แล้ว Loop ค่าจาก Database ที่ตรงกับค่าใน TextBox มาใส่ หากไม่ตรงเลยก็จะไม่มีเลย

Re: รบกวนตรวจ Code ให้ด้วยครับ

#32

by rich37 » Wed Apr 05, 2017 9:05 pm

snasui wrote::D เรื่องเดียวกันไม่ควรตั้งกระทูใหม่ครับ

ตัวอย่าง Code การนำค่าตรงตัวมาแสดงตามด้านล่างครับ

Code: Select all

Private Sub TextBox6_Change()
    Dim i As Long
    Dim n As Long
    Dim Str As String
    Str = Me.TextBox6.Text
    n = Me.ListBox1.ListCount
    For i = 0 To n - 1
        If Me.ListBox1.List(i) = Str Then
            Me.ListBox1.ListIndex = i
            Exit Sub
        End If
    Next i
End Sub
ขอโทษครับเรื่องการตั้งกระทู้ใหม่ ตามCode ที่อาจารย์ปรับปรุงมาให้ยังไม่ตรงกับความต้องการเท่าไหร่ครับ อยากให้เหมือนในรูปด้านล่างมากกว่าครับ ด้วยเหตุผลที่ว่า หากมีคดีที่ซ้ำกัน การ Vlookup ที่ใช้อยู่จะนำข้อมูลบนสุดมาแสดง ทำให้รายการต่อไปไม่สามารถแก้ไขได้
( หมายเลขคดีซ้ำกันได้ ) หากรายการขึ้นตามรูป ก็สามารถคลิกที่ Listbox เพื่อเลือกรายการที่ต้องการได้ทันที หากไม่มีตรงก็จะได้เพิ่มคดีใหม่เข้าไปได้ทันที่ครับ
Attachments
111.jpg
111.jpg (192.97 KiB) Viewed 178 times
333.jpg
333.jpg (85.04 KiB) Viewed 178 times

Re: รบกวนตรวจ Code ให้ด้วยครับ

#31

by snasui » Wed Apr 05, 2017 8:47 pm

:D เรื่องเดียวกันไม่ควรตั้งกระทูใหม่ครับ

ตัวอย่าง Code การนำค่าตรงตัวมาแสดงตามด้านล่างครับ

Code: Select all

Private Sub TextBox6_Change()
    Dim i As Long
    Dim n As Long
    Dim Str As String
    Str = Me.TextBox6.Text
    n = Me.ListBox1.ListCount
    For i = 0 To n - 1
        If Me.ListBox1.List(i) = Str Then
            Me.ListBox1.ListIndex = i
            Exit Sub
        End If
    Next i
End Sub
แต่หากจะให้แสดงเฉพาะค่าที่คล้ายกับค่าที่ต้องการค้นหา แนวทางนี้มาผิดทางครับ การทำเช่นนั้นควรจะ Loop จาก Database มาวางใน ListBox ไม่ใช่ให้เลือกรายการใน ListBox ที่ตรงกันกับค่าที่ต้องการค้นหาเช่น Code ด้านบน

การแสดงค่าใน ListBox ควรจะนำค่าจากต้นทางมาแสดง ไม่ใช่นำค่าใน ListBox เองมาแสดง เพราะหากทำเช่นนั้น เมื่อมีการค้นหาไปรอบนึงแล้ว ListBoxt จะเหลือเพียงบางจำนวนที่ตรงกับเงื่อนไขในครั้งนั้น หากคีย์ค้นหาครั้งต่อไปก็จะไม่เหลือรายการที่ตรงกับค่าที่ค้นหาอีก เช่นนี้เป็นต้นครับ

Re: รบกวนช่วยปรับปรุง Code Vba ครับ

#30

by rich37 » Wed Apr 05, 2017 7:26 pm

puriwutpokin wrote:ยกเลิกอันล่างครับ ใช้ตัวที่ผมให้ครับ ใช้ซ้อนกันไม่ได้ครับ
จุดประสงค์จริงๆคืออยากได้ตามรูปด้านล่างนี้ครับ มีกี่รายการก็โชว์ขึ้นมา จากรูปในช่องค้นหา พิมพ์ 12 ในListbox มี 2 รายการที่ มี 12 เพราะหมายเลขคดีแดงสามารถซ้ำกันได้ แต่ชื่อศาลจะไม่มีซ้ำกัน ครับ
อ้างอิงของเดิม
1.เวลาค้นหาข้อมูลหากไม่ตรงก็ไม่ต้องใส่ข้อมูล ให้ Listbox เป็นค่าว่าง
2.หากข้อมูลที่ค้นหาตรงก็ให้ใส่ข้อมูล
Attachments
111.jpg
111.jpg (192.97 KiB) Viewed 195 times

Re: รบกวนช่วยปรับปรุง Code Vba ครับ

#29

by puriwutpokin » Wed Apr 05, 2017 5:55 pm

ยกเลิกอันล่างครับ ใช้ตัวที่ผมให้ครับ ใช้ซ้อนกันไม่ได้ครับ

Re: รบกวนช่วยปรับปรุง Code Vba ครับ

#28

by rich37 » Wed Apr 05, 2017 5:43 pm

puriwutpokin wrote:ลองปรับเป็น

Code: Select all

Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim i As Long
    Dim n As Long
    Dim Str As String
    Str = Me.TextBox6.Text
    n = Me.ListBox1.ListCount
    For i = 0 To n - 1
        If Left(Me.ListBox1.List(i), Len(Str)) > 1 Then
            Me.ListBox1.ListIndex = i
            Exit Sub
        End If
    Next i
End Sub
ไม่รู้ว่าผมทำผิดตรงไหนครับ ลองปรับตามที่แจ้งมาแล้วก็ยังเหมือนเดิม
Attachments
111.jpg
111.jpg (54.82 KiB) Viewed 200 times
333.jpg
333.jpg (305.81 KiB) Viewed 200 times

Re: รบกวนช่วยปรับปรุง Code Vba ครับ

#27

by puriwutpokin » Wed Apr 05, 2017 5:23 pm

ลองปรับเป็น

Code: Select all

Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim i As Long
    Dim n As Long
    Dim Str As String
    Str = Me.TextBox6.Text
    n = Me.ListBox1.ListCount
    For i = 0 To n - 1
        If Left(Me.ListBox1.List(i), Len(Str)) > 1 Then
            Me.ListBox1.ListIndex = i
            Exit Sub
        End If
    Next i
End Sub

Re: รบกวนช่วยปรับปรุง Code Vba ครับ

#26

by rich37 » Wed Apr 05, 2017 4:35 pm

puriwutpokin wrote:ปรับเป็น

Code: Select all

If Me.ListBox1.Selected(i) = True Or TextBox1.Text = "" Then
ปรับแล้วก็ยังเหมือนเดิมครับ

Re: รบกวนช่วยปรับปรุง Code Vba ครับ

#25

by puriwutpokin » Wed Apr 05, 2017 4:24 pm

ปรับเป็น

Code: Select all

If Me.ListBox1.Selected(i) = True Or TextBox1.Text = "" Then

รบกวนช่วยปรับปรุง Code Vba ครับ

#24

by rich37 » Wed Apr 05, 2017 2:51 pm

Code: Select all

Private Sub TextBox6_Change()
    Dim i As Long
    Dim n As Long
    Dim Str As String
    Str = Me.TextBox6.Text
    n = Me.ListBox1.ListCount
    For i = 0 To n - 1
        If Left(Me.ListBox1.List(i), Len(Str)) = Str Then
            Me.ListBox1.ListIndex = i
            Exit Sub
        End If
    Next i
End Sub
จากCodeด้านบนเวลากดค้นหา จะดึงเอาข้อมูลที่ตรงมาใส่ใน ช่องข้อมูลต่างๆแต่หากไม่ตรง จะนำข้อมูลใกล้เคียงมาใส่แทน ซึ่งไม่ตรงกับความต้องการ สิ่งที่ต้องการคือ
1.เวลาค้นหาข้อมูลหากไม่ตรงก็ไม่ต้องใส่ข้อมูล ให้ Listbox เป็นค่าว่าง
2.หากข้อมูลที่ค้นหาตรงก็ให้ใส่ข้อมูล
ได้แนบไฟล์มาด้วยแล้ว ขอบคุณครับ
Attachments
ค้นหาสำนวน.rar
(458.98 KiB) Downloaded 17 times
222.jpg
222.jpg (287.32 KiB) Viewed 215 times

Re: รบกวนตรวจ Code ให้ด้วยครับ

#23

by snasui » Tue Apr 04, 2017 11:37 pm

:D ผมใช้หลายเครื่องและหลายที่และแม้จะเป็นเครื่องเดิมก็จะไม่ได้ Save ไฟล์เอาไว้

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

ไฟล์ล่าสุดที่นแนบมาไม่ได้ติดในบรรทัดนั้น ผมจึงไม่จำเป็นต้องแนบไฟล์นี้กลับไปแต่อย่างใดครับ

Top