ขอตัวอย่างการค้นหารายชื่อโดยใช้ VBA
Posted: Sun Nov 11, 2012 12:39 am
ผมขอตัวอย่างการค้นหารายชื่อโดยใช้ VBA
เนื่องจากที่เคยทำเวลาพิมพ์ผิดโปรแกรมจะ Error
ขอบคุณครับ
เนื่องจากที่เคยทำเวลาพิมพ์ผิดโปรแกรมจะ Error
ขอบคุณครับ
คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://www.snasui.com/
ลองแนบที่เคยทำมาด้วยจะได้ช่วยดูได้ครับyodpao.b wrote:เนื่องจากที่เคยทำเวลาพิมพ์ผิดโปรแกรมจะ Error
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
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เรียนอาจารย์ครับ จากไฟล์ที่แนบไปsnasui wrote:การอ้างถึง Object ต้องใช้เครื่องหมาย " ครอบ ซึ่งต้องเป็นข้อความ ยกเว้นเราสร้างตัวแปรให้กับ Object นั้นจึงไม่ต้องครอบด้วยเครื่องหมาย " ครับ
ผมไม่เข้าใจครับอาจาร์ยแสดงตัวอย่างให้ดูหน่อยได้ไหมครับที่อาจารย์พูดว่า " ยกเว้นเราสร้างตัวแปรให้กับ 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
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
CLng(CbB11.Text)ที่คุณไม่เข้าใจเพราะผมไม่เข้าใจว่าคุณถามอะไร ผมก็ตอบโดยทั่ว ๆ ไปครับyodpao.b wrote: ที่อาจารย์พูดว่า " ยกเว้นเราสร้างตัวแปรให้กับ Object นั้นจึงไม่ต้องครอบด้วยเครื่องหมาย " "
ผมไม่เข้าใจครับอาจาร์ยแสดงตัวอย่างให้ดูหน่อยได้ไหมครับ
ด้านล่างเป็นโคดที่ใช้อยู่ครับ
Code: Select all
lMatch = Application.Match(CbB11.Value, rAll, 0)Code: Select all
lMatch = Application.Match(CLng(CbB11.Text), rAll, 0)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
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 codeCode: 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
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 IfCode: 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 IfIf IsNumeric(CbB11.Text) Then คือให้ตรวจสอบว่า CbB11.Text เป็นตัวเลขหรือไม่ แม้จะถูกจัดเป็น Text แต่หากว่าเป็นตัวเลขล้วนมันก็ถูกมองว่าเป็นตัวเลขCode: Select all
'Other code
rAll.NumberFormat = "@"
If lCountif > 0 Then
lMatch = Application.Match(CbB11.Text, rAll, 0)
'Other code