Page 1 of 2
ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 10:10 am
by rich37
ช่วยปรับ codeให้ค้นหาคอลัมน์ B แทน คอลัมน์ A และให้ TextBox1 สามารถรับค่าเพื่อค้นหาและเพิ่มข้อมูลได้
ณ ตอนนี้หากกดค้นหาโดยใส่เป็นเลขลำดับจะเป็นการค้นหาแต่หากใส่หมายเลขคดีจะไม่มีการค้นหาใดๆเลย โดยคอลัมน์ A ซึ่งเป็นลำดับ ไม่ใช่หมายเลขคดีอย่างที่ต้องการ รบกวนด้วยครับ
Code: Select all
Private Sub CommandButton1_Click()
On Error Resume Next
Dim myRange As Range
Set myRange = Worksheets("Database").Range("_Data")
On Error Resume Next
TextBox2.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 3, False)
TextBox3.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 4, False)
TextBox4.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 5, False)
TextBox5.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 6, False)
TextBox6.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 7, False)
ComboBox1.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 8, False)
ComboBox2.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 9, False)
End Sub
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 11:23 am
by DhitiBank
ลองแบบนี้ครับ
1. ปรับสูตร range name ชื่อ _Data
เป็น
=OFFSET(Database!$A$1,1,1,COUNTA(Database!$A:$A)-1,COUNTA(Database!$1:$1)-1)
2. ปรับโค้ดในส่วนที่เป็น Vlookup นิดหน่อยครับ
จากเดิม
Application.WorksheetFunction.VLookup([color=#FF0000]--([/color]TextBox1.Value[color=#FF0000])[/color], myRange, 3, False)
เป็น
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 3, False)
เอาออกให้หมด แล้วลองรันโค้ดดูใหม่ครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 11:41 am
by puriwutpokin
ตาม คุณDhitiBank ให้เปลี่ยนลำดับการค้นหาตามกันไปด้วย
Code: Select all
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange,3, False)
เป็น
Code: Select all
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange,2, False)
รันลดไปเรื่อยนะครับ 4 เป็น 3 และตัวต่อไปด้วยครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 11:49 am
by rich37
DhitiBank wrote:ลองแบบนี้ครับ
1. ปรับสูตร range name ชื่อ _Data
เป็น
=OFFSET(Database!$A$1,1,1,COUNTA(Database!$A:$A)-1,COUNTA(Database!$1:$1)-1)
2. ปรับโค้ดในส่วนที่เป็น Vlookup นิดหน่อยครับ
จากเดิม
Application.WorksheetFunction.VLookup([color=#FF0000]--([/color]TextBox1.Value[color=#FF0000])[/color], myRange, 3, False)
เป็น
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 3, False)
เอาออกให้หมด แล้วลองรันโค้ดดูใหม่ครับ
ขอบคุณครับ ลองปรับแล้วใช้งานได้ครับ ในส่วนหากต้องการเพิ่มข้อมูลหรือแก้ไขข้อมูลจกาที่ค้นหาหรือเพิ่มใหม่ควรปรับแก้อย่างไรครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 11:52 am
by rich37
puriwutpokin wrote:ตาม คุณDhitiBank ให้เปลี่ยนลำดับการค้นหาตามกันไปด้วย
Code: Select all
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange,3, False)
เป็น
Code: Select all
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange,2, False)
รันลดไปเรื่อยนะครับ 4 เป็น 3 และตัวต่อไปด้วยครับ
ปรับแล้วใช้ได้ครับ ขอบคุณครับ แต่ติดปัญหาใหม่ครับว่าจะกดเพิ่มข็อมูลหรือกดเพื่อแก้ไขบางรายการที่ค้นหามาแล้วให้กลับไปไว้ที่จุดที่ค้นหาออกมาครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 1:17 pm
by puriwutpokin
ลองดูตามไฟล์แนบครับติดตรงไหนค่อยมาดูกันอีกทีครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 2:00 pm
by rich37
puriwutpokin wrote:ลองดูตามไฟล์แนบครับติดตรงไหนค่อยมาดูกันอีกทีครับ
ขอบคุณมากๆครับ ขอทดสอบดูก่อนนะครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 2:16 pm
by puriwutpokin
หรือทำเป็นปุ๋มเดียวก็ปรับตามโค้ดนี้ครับใช้ฟอร์มเดิมครับ
Code: Select all
Private Sub CommandButton2_Click()
Dim icolumn As Long
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Database")
'find first empty row in database
icolumn = ws.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row
'Check for Id
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "คุณยังไม่ได้ใส่ข้อมูล"
Exit Sub
Else
If Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
'copy the data to the database
ws.Cells(icolumn, 2).Value = Me.TextBox1.Value
ws.Cells(icolumn, 3).Value = Me.TextBox2.Value
ws.Cells(icolumn, 4).Value = Me.TextBox3.Value
ws.Cells(icolumn, 5).Value = Me.TextBox4.Value
ws.Cells(icolumn, 6).Value = Me.TextBox5.Value
ws.Cells(icolumn, 7).Value = Me.TextBox6.Value
ws.Cells(icolumn, 8).Value = Me.ComboBox1.Value
ws.Cells(icolumn, 9).Value = Me.ComboBox2.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "เพิ่มข้อมูลเรียบร้อย"
Else
If Trim(Me.TextBox1.Value) = "" Then
MsgBox "คุณยังไม่ได้ใส่ข้อมูล"
Exit Sub
Else
iRow = _
Application.WorksheetFunction.Match(TextBox1.Value, ws.Range("B2:B10000"), 0) + 1
ws.Cells(iRow, 2).Value = Me.TextBox1.Value
ws.Cells(iRow, 3).Value = Me.TextBox2.Value
ws.Cells(iRow, 4).Value = Me.TextBox3.Value
ws.Cells(iRow, 5).Value = Me.TextBox4.Value
ws.Cells(iRow, 6).Value = Me.TextBox5.Value
ws.Cells(iRow, 7).Value = Me.TextBox6.Value
ws.Cells(iRow, 8).Value = Me.ComboBox1.Value
ws.Cells(iRow, 9).Value = Me.ComboBox2.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "แก้ไขข้อมูลเรียบร้อย"
End If
End If
End If
End Sub
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 2:53 pm
by rich37
puriwutpokin wrote:หรือทำเป็นปุ๋มเดียวก็ปรับตามโค้ดนี้ครับใช้ฟอร์มเดิมครับ
Code: Select all
Private Sub CommandButton2_Click()
Dim icolumn As Long
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Database")
'find first empty row in database
icolumn = ws.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row
'Check for Id
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "คุณยังไม่ได้ใส่ข้อมูล"
Exit Sub
Else
If Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
'copy the data to the database
ws.Cells(icolumn, 2).Value = Me.TextBox1.Value
ws.Cells(icolumn, 3).Value = Me.TextBox2.Value
ws.Cells(icolumn, 4).Value = Me.TextBox3.Value
ws.Cells(icolumn, 5).Value = Me.TextBox4.Value
ws.Cells(icolumn, 6).Value = Me.TextBox5.Value
ws.Cells(icolumn, 7).Value = Me.TextBox6.Value
ws.Cells(icolumn, 8).Value = Me.ComboBox1.Value
ws.Cells(icolumn, 9).Value = Me.ComboBox2.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "เพิ่มข้อมูลเรียบร้อย"
Else
If Trim(Me.TextBox1.Value) = "" Then
MsgBox "คุณยังไม่ได้ใส่ข้อมูล"
Exit Sub
Else
iRow = _
Application.WorksheetFunction.Match(TextBox1.Value, ws.Range("B2:B10000"), 0) + 1
ws.Cells(iRow, 2).Value = Me.TextBox1.Value
ws.Cells(iRow, 3).Value = Me.TextBox2.Value
ws.Cells(iRow, 4).Value = Me.TextBox3.Value
ws.Cells(iRow, 5).Value = Me.TextBox4.Value
ws.Cells(iRow, 6).Value = Me.TextBox5.Value
ws.Cells(iRow, 7).Value = Me.TextBox6.Value
ws.Cells(iRow, 8).Value = Me.ComboBox1.Value
ws.Cells(iRow, 9).Value = Me.ComboBox2.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "แก้ไขข้อมูลเรียบร้อย"
End If
End If
End If
End Sub
ถ้าเราจะเพิ่มกล่องรับวันที่ ที่เราจัดเก็บข้อมูลเข้าไปสามารถเพิ่มได้ไหมครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 3:05 pm
by puriwutpokin
ก็ทำได้เมื่อ TextBox อื่นๆครับ ลองเขียนมาดูก่อนครับ ติดขัดแล้วค่อยมาถามกันใหม่ครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Thu Mar 16, 2017 3:06 pm
by rich37
puriwutpokin wrote:ก็ทำได้เมื่อ TextBox อื่นๆครับ ลองเขียนมาดูก่อนครับ ติดขัดแล้วค่อยมาถามกันใหม่ครับ
ขอบคุณครับลองปรับใส่วันที่แล้ว ได้ผลตามต้องการครับ แต่ติดปัญหาตรงที่ใน Textbox7 จะโชว์วันที่ในรูปแบบที่เป็นตัวเลข แบบนี้ครับ 241136 ซึ่งค่าในชีต Database คือ 15 มีนาคม 2560 ( พิมพ์ 15/3/2017) แก้แบบไหนดีครับ
Code: Select all
Private Sub UserForm_Initialize()
TextBox7.Value = Format(Date, "dd mmmm yyyy")
A = "Person!_Type"
ComboBox1.RowSource = A
B = "Person!_Person"
ComboBox2.RowSource = B
End Sub
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Sat Mar 18, 2017 8:16 am
by rich37
หากต้องการเปลี่ยนการค้นหาให้สามารถค้นหาได้ทั้งหมด ใน Worksheets("Database")ควรจะแก้ไขอย่างไรดีครับ
Code: Select all
Private Sub CommandButton2_Click()
Dim icolumn As Long
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Database")
'find first empty row in database
icolumn = ws.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row
'Check for Id
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "คุณยังไม่ได้ใส่ข้อมูล"
Exit Sub
Else
If Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
'copy the data to the database
ws.Cells(icolumn, 2).Value = Me.TextBox1.Value
ws.Cells(icolumn, 3).Value = Me.TextBox2.Value
ws.Cells(icolumn, 4).Value = Me.TextBox3.Value
ws.Cells(icolumn, 5).Value = Me.TextBox4.Value
ws.Cells(icolumn, 6).Value = Me.TextBox5.Value
ws.Cells(icolumn, 7).Value = Me.TextBox6.Value
ws.Cells(icolumn, 8).Value = Me.ComboBox1.Value
ws.Cells(icolumn, 9).Value = Me.ComboBox2.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "เพิ่มข้อมูลเรียบร้อย"
Else
If Trim(Me.TextBox1.Value) = "" Then
MsgBox "คุณยังไม่ได้ใส่ข้อมูล"
Exit Sub
Else
iRow = _
Application.WorksheetFunction.Match(TextBox1.Value, ws.Range("B2:B10000"), 0) + 1
ws.Cells(iRow, 2).Value = Me.TextBox1.Value
ws.Cells(iRow, 3).Value = Me.TextBox2.Value
ws.Cells(iRow, 4).Value = Me.TextBox3.Value
ws.Cells(iRow, 5).Value = Me.TextBox4.Value
ws.Cells(iRow, 6).Value = Me.TextBox5.Value
ws.Cells(iRow, 7).Value = Me.TextBox6.Value
ws.Cells(iRow, 8).Value = Me.ComboBox1.Value
ws.Cells(iRow, 9).Value = Me.ComboBox2.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "แก้ไขข้อมูลเรียบร้อย"
End If
End If
End If
End Sub
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Sat Mar 18, 2017 9:32 am
by puriwutpokin
แนบไฟล์ล่าสุดมาดู ครับจะได้เข้าใจตรงกันครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Sat Mar 18, 2017 9:36 am
by rich37
puriwutpokin wrote:แนบไฟล์ล่าสุดมาดู ครับจะได้เข้าใจตรงกันครับ
ได้แนบไฟล์มาแล้วครับ และหากต้องการให้กดค้นหาแล้วไม่พบข้อมูลให้ MsgBox ขึ้นว่าไม่พบข้อมูลด้วยผมลองแล้วไม่สามารถทำได้ครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Sat Mar 18, 2017 10:35 am
by puriwutpokin
Code: Select all
...Other code
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
...Other code
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Sat Mar 18, 2017 10:44 am
by rich37
puriwutpokin wrote:Code: Select all
...Other code
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
...Other code
ค่าใน Textbox1 ไม่ว่างนี่สิครับเพราะเราใส่คำเข้าไปให้ค้นหา
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Sat Mar 18, 2017 10:57 am
by puriwutpokin
Code: Select all
...Other code
If Trim(Me.TextBox1.Value) = "" Or Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
...Other code
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Sat Mar 18, 2017 11:09 am
by rich37
puriwutpokin wrote:Code: Select all
...Other code
If Trim(Me.TextBox1.Value) = "" Or Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
...Other code
ผลออกมาว่า การค้นหา ไม่พบทั้งหมดเลย ทั้งๆที่ข้อมูลมีครับ
ตามไฟล์รูปแนบครับ
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Sat Mar 18, 2017 11:10 am
by puriwutpokin
แก้ไขโค้ดครับ
Code: Select all
...other code On Error Resume Next
Dim ws As Worksheet
Set ws = Worksheets("Database")
Dim myRange As Range
Set myRange = Worksheets("Database").Range("_Data")
If Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
Me.TextBox1.SetFocus
MsgBox "ไม่พบข้อมูล", vbInformation, "ระบบค้นหาสำนวน"
Exit Sub...other code
Re: ช่วยปรับ codeให้ค้นหาคอลัมน์
Posted: Sat Mar 18, 2017 11:19 am
by rich37
puriwutpokin wrote:แก้ไขโค้ดครับ
Code: Select all
...other code On Error Resume Next
Dim ws As Worksheet
Set ws = Worksheets("Database")
Dim myRange As Range
Set myRange = Worksheets("Database").Range("_Data")
If Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
Me.TextBox1.SetFocus
MsgBox "ไม่พบข้อมูล", vbInformation, "ระบบค้นหาสำนวน"
Exit Sub...other code
ใช้ได้แล้วครับขึ้นโชว์ข้อความตามที่ต้องการ ขอบคุณครับ
และหากต้องการเปลี่ยนการค้นหาให้สามารถค้นหาได้ทั้งหมด ใน Worksheets("Database") โดยการที่จะให้พิมพ์ค่าไหนก็ได้ลงใน Textbox1โดยไม่จำกัดเฉพาะว่าเป็นหมายเลขคดีแดง สามารถทำได้ไหมครับ ช่วยแนะนำด้วยครับ