ขอตัวอย่างการค้นหารายชื่อโดยใช้ VBA

[yodpao.b]

ผมขอตัวอย่างการค้นหารายชื่อโดยใช้ VBA
เนื่องจากที่เคยทำเวลาพิมพ์ผิดโปรแกรมจะ Error
ขอบคุณครับ

[snasui]

เนื่องจากที่เคยทำเวลาพิมพ์ผิดโปรแกรมจะ Error

ลองแนบที่เคยทำมาด้วยจะได้ช่วยดูได้ครับ

[yodpao.b]

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

Code: Select all

Private Sub CommandButton1_Click()
On Error Resume Next
    If TextBox1.Text = True Then
       
Sheets("S_Constant").Select
Range("B6").Select
Do While True
        If ActiveCell.Value = TextBox1.Text Then
         TextBox11.Text = ActiveCell.Offset(0, 3).Value
         TextBox12.Text = ActiveCell.Offset(0, 4).Value
         TextBox13.Text = ActiveCell.Offset(0, 7).Value
         TextBox14.Text = ActiveCell.Offset(0, 8).Value
         TextBox15.Text = ActiveCell.Offset(0, 9).Value
         Exit Sub
     End If
     ActiveCell.Offset(1, 0).Select
Loop
        Else
                MsgBox " กรุณาพิมพ์เลขประจำตัวก่อน", vbExclamation, "ฐานข้อมูลบุคคล"
        End If
End Sub

ผมได้แนบไฟล์มาด้วยครับ
ปุ่มเรียกอยู่ในหน้าเรียกฟอร์มครับ
หลังจากฟอร์มขึ้นมาให้พิมพ์เลขประจำตัว 554251
ผลลัพท์ที่ได้ถูก
แต่ถ้าพิมพ์เลขประจำตัว 554250
ผลลัพท์ที่ได้ ERRor

ขอบคุณครับ

[snasui]

ลองดูการปรับ Code ตามด้านล่างครับ

Code: Select all

Private Sub CommandButton1_Click()
'    On Error Resume Next
'    If TextBox1.Text = True Then
'        Sheets("S_Constant").Select
'        Range("B6").Select
'        Do While True
    Dim rAll As Range
    Dim lMatch As Long
    Dim lCountif As Long
    
    With Sheets("S_Constant")
        Set rAll = .Range("B:B")
        lCountif = Application.CountIf(rAll, TextBox1.Text)
        If lCountif > 0 Then
            lMatch = Application.Match(TextBox1.Text, rAll, 0)
            TextBox11.Text = .Range("B" & lMatch).Offset(0, 3)
            TextBox12.Text = .Range("B" & lMatch).Offset(0, 4)
            TextBox13.Text = .Range("B" & lMatch).Offset(0, 7)
            TextBox14.Text = .Range("B" & lMatch).Offset(0, 8)
            TextBox15.Text = .Range("B" & lMatch).Offset(0, 9)
        Else
            MsgBox " ¡ÃسҾÔÁ¾ìàÅ¢»ÃШӵÑÇ¡è͹", vbExclamation, "°Ò¹¢éÍÁÙźؤ¤Å"
            TextBox1.Text = ""
        End If
    End With
'            If ActiveCell.Value = TextBox1.Text Then
'                TextBox11.Text = ActiveCell.Offset(0, 3).Value
'                TextBox12.Text = ActiveCell.Offset(0, 4).Value
'                TextBox13.Text = ActiveCell.Offset(0, 7).Value
'                TextBox14.Text = ActiveCell.Offset(0, 8).Value
'                TextBox15.Text = ActiveCell.Offset(0, 9).Value
'                Exit Sub
'            End If
'             ActiveCell.Offset(1, 0).Select
'        Loop
'    Else
'    End If
End Sub

[yodpao.b]

ทำได้แล้วครับ
ขอบคุณอาจาร์ยมากครับ

[yodpao.b]

เรียนอาจารย์ครับ
Sheets("S_Constant")
Range("B:B")
ทำไมถึงต้องเป็น ข้อความด้วยครับ
เป็นตัวเลขได้ไหมครับ
ผมลองแล้วมัน EEror ครับ

[snasui]

การอ้างถึง Object ต้องใช้เครื่องหมาย " ครอบ ซึ่งต้องเป็นข้อความ ยกเว้นเราสร้างตัวแปรให้กับ Object นั้นจึงไม่ต้องครอบด้วยเครื่องหมาย " ครับ

[yodpao.b]

การอ้างถึง Object ต้องใช้เครื่องหมาย " ครอบ ซึ่งต้องเป็นข้อความ ยกเว้นเราสร้างตัวแปรให้กับ Object นั้นจึงไม่ต้องครอบด้วยเครื่องหมาย " ครับ

เรียนอาจารย์ครับ จากไฟล์ที่แนบไป
Sheets("Variable")
Range("G:G")
นั้นเป็นตัวเลข จึงทำให้เวลารันโปรแกรม EEROR
แต่ถ้าผมทำให้เป็น จัดรุปแบบข้อความ โดยใส่เครื่องหมายคำพูด " ' " ก็จะสามารถ Run ได้

ที่อาจารย์พูดว่า " ยกเว้นเราสร้างตัวแปรให้กับ Object นั้นจึงไม่ต้องครอบด้วยเครื่องหมาย " "

ผมไม่เข้าใจครับอาจาร์ยแสดงตัวอย่างให้ดูหน่อยได้ไหมครับ
ด้านล่างเป็นโคดที่ใช้อยู่ครับ

Code: Select all

Private Sub CommandButton1_Click()

    Dim rAll As Range
    Dim lMatch As Long
    Dim lCountif As Long
    
    With Sheets("Variable")
        Set rAll = .Range("G:G")
        lCountif = Application.CountIf(rAll, CbB11.Text)
        If lCountif > 0 Then
            lMatch = Application.Match(CbB11.Text, rAll, 0)
            TB12.Text = .Range("G" & lMatch).Offset(0, 1)
            TB13.Text = .Range("G" & lMatch).Offset(0, 2)
            TB14.Text = .Range("G" & lMatch).Offset(0, 3)
            TB15.Text = .Range("G" & lMatch).Offset(0, 4)
            TB16.Text = .Range("G" & lMatch).Offset(0, 6)
        Else
             MsgBox " ¡ÃسҾÔÁ¾ìàÅ¢»ÃШӵÑÇ¡è͹ËÃ×ÍàÅ¢»ÃШӵÑÇäÁèÁÕã¹°Ò¹¢éÍÁÙÅ", vbExclamation, "°Ò¹¢éÍÁÙźؤ¤Å"
             CbB11.Text = ""
        End If
    End With
End Sub

[snasui]

การที่โปรแกรม Error เนื่องจาก CbB11.Text ให้ค่าเป็น Text เมื่อนำไป Match กับ Number จึงเกิด Error ดูตัวอย่างประกอบด้านล่างครับ

[yodpao.b]

Code: Select all

Private Sub CommandButton1_Click()

    Dim rAll As Range
    Dim lMatch As Long
    Dim lCountif As Long
    
    With Sheets("Variable")
        Set rAll = .Range("G:G")
        lCountif = Application.CountIf(rAll, CbB11.Value)
        If lCountif > 0 Then
            lMatch = Application.Match(CbB11.Value, rAll, 0)
            TB12.Text = .Range("G" & lMatch).Offset(0, 1)
            TB13.Text = .Range("G" & lMatch).Offset(0, 2)
            TB14.Text = .Range("G" & lMatch).Offset(0, 3)
            TB15.Text = .Range("G" & lMatch).Offset(0, 4)
            TB16.Text = .Range("G" & lMatch).Offset(0, 6)
        Else
             MsgBox " ¡ÃسҾÔÁ¾ìàÅ¢»ÃШӵÑÇ¡è͹ËÃ×ÍàÅ¢»ÃШӵÑÇäÁèÁÕã¹°Ò¹¢éÍÁÙÅ", vbExclamation, "°Ò¹¢éÍÁÙźؤ¤Å"
             CbB11.Value = ""
        End If
    End With
End Sub

ผมลองเปลี่ยนจาก TEXT เป็น Value แล้วครับ ผลที่ได้ยัง EEROR

[snasui]

ก็เพราะว่ามันยังเป็น Text เช่นเดิมครับ ลอง Convert ให้เป็น Long โดยใช้ Clng เข้าไปครอบ จะได้เป็น

CLng(CbB11.Text)

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

[snasui]

ที่อาจารย์พูดว่า " ยกเว้นเราสร้างตัวแปรให้กับ Object นั้นจึงไม่ต้องครอบด้วยเครื่องหมาย " "

ผมไม่เข้าใจครับอาจาร์ยแสดงตัวอย่างให้ดูหน่อยได้ไหมครับ
ด้านล่างเป็นโคดที่ใช้อยู่ครับ

ที่คุณไม่เข้าใจเพราะผมไม่เข้าใจว่าคุณถามอะไร ผมก็ตอบโดยทั่ว ๆ ไปครับ

[yodpao.b]

ขอบคุณครับ
ผมลองเปลียนตามที่อาจารย์บอก
จาก Code ด้านล่าง

Code: Select all

lMatch = Application.Match(CbB11.Value, rAll, 0)

เป็น Code นี้

Code: Select all

lMatch = Application.Match(CLng(CbB11.Text), rAll, 0)

ใช้ได้ดีครับ แต่เปลี่ยนบรรทัดนี้บรรทัดเดี๋ยวใช่ไหมครับ

[snasui]

บรรทัดไหนมีการใช้ฟังก์ชั่น Match เข้ามาช่วยต้องเปลี่ยนทุกบรรทัดครับ

[yodpao.b]

Re: ขอตัวอย่างการค้นหารายชื่อโดยใช้ VBA

untitled123.GIF (20.98 KiB) Viewed 1016 times

จากรูปข้อมูลในวงกลมมีทั้งข้อความ และ ตัวเลข

ถ้าผมใช้ โคด lMatch = Application.Match(CbB02.Text, rAll, 0) ก็จะเรียกได้ เฉพาะ ข้อความ
ถ้าผมใช้ โคด lMatch = Application.Match(CLng(CbB02.Text), rAll, 0) ก็จะเรียกได้ เฉพาะ ตัวเลข
ผมเลยนำโคดมาผสมกันแบบนี้ lMatch = Application.Match(CbB02.Text, rAll, 0) Or Application.Match(CLng(CbB02.Text), rAll, 0)
ที่นี้เรียกไม่ได้เลยครับ

อยากได้ โคดที่อ่านได้ทั้ง ข้อความ และ ตัวเลข ครับจะแขอย่างไรดี

รูปแบบที่ใช้งานฟอร์มดังรูปล่างที่วงกลม จะเห็นว่ามีทั้งต้วเลขและตัวหนังสือผสมกัน อีกบรรทัด ก็จะเป็นเฉพาะตัวเลขอย่างเดียว

untitled1234.GIF (12.21 KiB) Viewed 1015 times

ผมได้แนบไฟล์มาด้วย

Code: Select all

Private Sub CommandButton2_Click()
On Error Resume Next

    Dim rAll As Range
    Dim lMatch As Long
    Dim lCountif As Long
    
    imgBox.Picture = LoadPicture("")
    Sheets("HistoryDurable").Select
    Range("F7").Select
    
    With Sheets("HistoryDurable")
        Set rAll = .Range("F:F")
        lCountif = Application.CountIf(rAll, CbB02.Text)
        If lCountif > 0 Then
            lMatch = Application.Match(CbB02.Text, rAll, 0) Or Application.Match(CLng(CbB02.Text), rAll, 0)                          '   lMatch = Application.Match(CLng(CbB02.Text), rAll, 0)  ãªéä´é¡ÅѺµÑÇàÅ¢ÍÂèÒ§à´ÕÂÇ
            CbB01.Text = Clear
            TB1.Text = .Range("F" & lMatch).Offset(0, -4).Value
            TB2.Text = .Range("F" & lMatch).Offset(0, -3).Value
            CbB3.Text = .Range("F" & lMatch).Offset(0, -2).Value
            CbB4.Text = .Range("F" & lMatch).Offset(0, -1).Value
            TB5.Text = .Range("F" & lMatch).Offset(0, 0).Value
            TB16.Text = .Range("F" & lMatch).Offset(0, 1).Value
            TB6.Text = .Range("F" & lMatch).Offset(0, 2).Value
            CbB7.Text = .Range("F" & lMatch).Offset(0, 3).Value
            CbB8.Text = .Range("F" & lMatch).Offset(0, 4).Value
            TB9.Text = .Range("F" & lMatch).Offset(0, 5).Value
            TB10.Text = .Range("F" & lMatch).Offset(0, 6).Value
            TB11.Text = .Range("F" & lMatch).Offset(0, 7).Value
            CbB12.Text = .Range("F" & lMatch).Offset(0, 8).Value
            CbB13.Text = .Range("F" & lMatch).Offset(0, 9).Value
            TB14.Text = .Range("F" & lMatch).Offset(0, 37).Value
            TB15.Text = .Range("F" & lMatch).Offset(0, 38).Text
            TB21.Text = .Range("F" & lMatch).Offset(0, 10).Value
            TB22.Text = .Range("F" & lMatch).Offset(0, 11).Text                       ' à¡ÕÂǡѺáÊ´§¤èÒÇѹ·Õè text ,value
            CbB23.Text = .Range("F" & lMatch).Offset(0, 12).Value
            CbB24.Text = .Range("F" & lMatch).Offset(0, 13).Value
            TB25.Text = .Range("F" & lMatch).Offset(0, 14).Text
            TB31.Text = .Range("F" & lMatch).Offset(0, 15).Value
            TB41.Text = .Range("F" & lMatch).Offset(0, 16).Value
            TB42.Text = .Range("F" & lMatch).Offset(0, 17).Text
            CbB43.Text = .Range("F" & lMatch).Offset(0, 18).Value
            TB44.Text = .Range("F" & lMatch).Offset(0, 19).Value
            TB45.Text = .Range("F" & lMatch).Offset(0, 20).Value + " , " + .Range("F" & lMatch).Offset(0, 21).Value + " , " + .Range("F" & lMatch).Offset(0, 22).Value + " , " + .Range("F" & lMatch).Offset(0, 23).Value
            CbB46.Text = .Range("F" & lMatch).Offset(0, 24).Value
            TB47.Text = .Range("F" & lMatch).Offset(0, 25).Value
            TB48.Text = .Range("F" & lMatch).Offset(0, 26).Value + " , " + .Range("F" & lMatch).Offset(0, 27).Value + " , " + .Range("F" & lMatch).Offset(0, 28).Value + " , " + .Range("F" & lMatch).Offset(0, 29).Value
            CbB51.Text = .Range("F" & lMatch).Offset(0, 30).Value
            TB52.Text = .Range("F" & lMatch).Offset(0, 31).Value
            TB53.Text = .Range("F" & lMatch).Offset(0, 32).Value + " , " + .Range("F" & lMatch).Offset(0, 33).Value + " , " + .Range("F" & lMatch).Offset(0, 34).Value + " , " + .Range("F" & lMatch).Offset(0, 35).Value
            TB61.Text = .Range("F" & lMatch).Offset(0, 36).Value
            CbB17.Text = .Range("F" & lMatch).Offset(0, 39).Value
            TB18.Text = .Range("F" & lMatch).Offset(0, 40).Text
            CommandButton1.Enabled = False
        Else
             MsgBox " ¡ÃسҾÔÁ¾ìÅӴѺ·Õè¡è͹ ËÃ×Í ÅӴѺ·ÕèäÁèÁÕã¹°Ò¹¢éÍÁÙÅ", vbExclamation, "°Ò¹¢éÍÁÙźؤ¤Å"
             CbB02.Text = ""
        End If
    End With
End Sub

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

'Other code
If lCountif > 0 Then
     If IsNumeric(CbB02.Text) Then
          lMatch = Application.Match(CDbl(CbB02.Text), rAll, 0)
     Else
          lMatch = Application.Match(CbB02.Text, rAll, 0)
     End If
'Other code

[yodpao.b]

ขอบคุุณมากครับอาจารย์
ผมต้องการโคดแบบนี้มานานแล้วครับ
เพราะที่ทำงานบางคนต้องการพิมพ์เอง บางคนก็ใช้boxlist
แต่เวลาพิพม์ผิดมักจะ EEror
แต่ตอนนี้ไม่มีปัญหาแล้วครับ
ขอบคุุณมาก

[yodpao.b]

เรียนอาจารยืครับต้องขอโทษครับ
Code ที่อาจารย์ให้ Ok ครับ

แต่รบกวนอาจารย์ช่วยดูให้หน่อย เมื่อนำมาใช้กับอีก file กับใช้ไม่ได้ งงมากครับ ช่วยแก้ไขให้ด้วยครับ

Code: Select all

Private Sub CommandButton1_Click()
On Error Resume Next
    Dim rAll As Range
    Dim lMatch As Long
    Dim lCountif As Long
    
    With Sheets("Variable")
        Set rAll = .Range("G:G")
        lCountif = Application.CountIf(rAll, CbB11.Text)
        If lCountif > 0 Then
                If IsNumeric(CbB11.Text) Then
                     lMatch = Application.Match(CDbl(CbB11.Text), rAll, 0)    '    ãªéä´é¡ÅѺµÑÇàÅ¢ÍÂèÒ§à´ÕÂÇ
                Else
                     lMatch = Application.Match(CbB11.Text, rAll, 0)      '    ãªéä´é¡ÅѺ¢éͤÇÒÁÍÂèÒ§à´ÕÂÇ
                End If
                    TB12.Text = .Range("G" & lMatch).Offset(0, 1)
                    TB13.Text = .Range("G" & lMatch).Offset(0, 2)
                    TB14.Text = .Range("G" & lMatch).Offset(0, 3)
                    TB15.Text = .Range("G" & lMatch).Offset(0, 4)
                    TB16.Text = .Range("G" & lMatch).Offset(0, 6)
        Else
             MsgBox " ¡ÃسҾÔÁ¾ìàÅ¢»ÃШӵÑÇ¡è͹ËÃ×ÍàÅ¢»ÃШӵÑÇäÁèÁÕã¹°Ò¹¢éÍÁÙÅ", vbExclamation, "°Ò¹¢éÍÁÙźؤ¤Å"
             CbB11.Text = ""
        End If
    End With
End Sub

จากรูปด้านล่าง
ถ้าเลือก 178187 ข้อมูลเปลียนแปลง (ถูก)
แต่ถ้าเลือก 032195 ข้อมูลไม่ยอมเปลียนแปลง (ผิด)

Capture1.JPG (41.71 KiB) Viewed 999 times

[yodpao.b]

อาจารย์ครับอาจารย์ผมลองเดาเปลี่ยนโคดแล้วดังนี้

Code: Select all

Private Sub CommandButton1_Click()
On Error Resume Next
    Dim rAll As Range
    Dim lMatch As Long
    Dim lCountif As Long
    
    With Sheets("Variable")
        Set rAll = .Range("G:G")
        lCountif = Application.CountIf(rAll, CbB11.Text)
        If lCountif > 0 Then
                If IsNumeric(CbB11.Text) Then
                     lMatch = Application.Match(CDbl(CbB11.Text), rAll, 0)    '    ใช้ได้กลับตัวเลขอย่างเดียว
                End If
                If IsNumeric(CbB11.Text) Then
                     lMatch = Application.Match(CbB11.Text, rAll, 0)      '    ใช้ได้กลับข้อความอย่างเดียว
                End If

                    TB12.Text = .Range("G" & lMatch).Offset(0, 1)
                    TB13.Text = .Range("G" & lMatch).Offset(0, 2)
                    TB14.Text = .Range("G" & lMatch).Offset(0, 3)
                    TB15.Text = .Range("G" & lMatch).Offset(0, 4)
                    TB16.Text = .Range("G" & lMatch).Offset(0, 6)
        Else
             MsgBox " กรุณาพิมพ์เลขประจำตัวก่อนหรือเลขประจำตัวไม่มีในฐานข้อมูล", vbExclamation, "ฐานข้อมูลบุคคล"
             CbB11.Text = ""
        End If
    End With
End Sub

ใช้ได้ครับ
แต่ขอถามว่าถูกต้องไหมครับในการเขียนแบบนี้
โคดที่แก้ไขแล้ว

Code: Select all

        If lCountif > 0 Then
                If IsNumeric(CbB11.Text) Then
                     lMatch = Application.Match(CDbl(CbB11.Text), rAll, 0)    '    ใช้ได้กลับตัวเลขอย่างเดียว
                End If
                If IsNumeric(CbB11.Text) Then
                     lMatch = Application.Match(CbB11.Text, rAll, 0)      '    ใช้ได้กลับข้อความอย่างเดียว
                End If

ส่วนโคดเดิม

Code: Select all

If lCountif > 0 Then
     If IsNumeric(CbB02.Text) Then
          lMatch = Application.Match(CDbl(CbB02.Text), rAll, 0)
     Else
          lMatch = Application.Match(CbB02.Text, rAll, 0)
     End If

ความหมายทั้ง 2 โคด มันน่าจะหมายความเหมือนกันไหมครับ
และถ้าเหมือนกันทำไมถึงไม่ถูกต้องครับ

[snasui]

ที่เขียนมานั้นไม่ถูกต้องครับ เงื่อนไขเดียวกันแต่ให้ Match คนละแบบสามารถอธิบายได้ด้วยตัวของมันเองอยู่แล้วว่าไม่ถูกต้อง

If IsNumeric(CbB11.Text) Then คือให้ตรวจสอบว่า CbB11.Text เป็นตัวเลขหรือไม่ แม้จะถูกจัดเป็น Text แต่หากว่าเป็นตัวเลขล้วนมันก็ถูกมองว่าเป็นตัวเลข

เพื่อให้ง่ายต่อการใช้งานให้แปลง rAll ให้เป็น Text เสียก่อนแล้วค่อยนำค่าใน TextBox ไป Math กับ rAll ซึ่งสามารถปรับ Code เป็น

Code: Select all

'Other code
rAll.NumberFormat = "@"
If lCountif > 0 Then
    lMatch = Application.Match(CbB11.Text, rAll, 0)
'Other code