Page 2 of 2
Re: Add value in ListBox
Posted: Wed Jan 18, 2012 4:34 pm
by ANUSARA
Code: Select all
Private Sub ListBox1_SelectNewRW_Click()
With Worksheets("UsEF_RW")
TextBox14_SelectCF.Value = Application.VLookup(Me.ListBox1_SelectNewRW, .Range("E15:Q100"), 6, False)
TextBox12_SelectSource.Value = Application.VLookup(Me.ListBox1_SelectNewRW, .Range("E15:Q100"), 8, False)
TextBox11_SelectYear.Value = Application.VLookup(Me.ListBox1_SelectNewRW, .Range("E15:Q100"), 9, False)
TextBox10_SelectLocation.Value = Application.VLookup(Me.ListBox1_SelectNewRW, .Range("E15:Q100"), 10, False)
TextBox9_SelectComment.Value = Application.VLookup(Me.ListBox1_SelectNewRW, .Range("E15:Q100"), 11, False)
End With
End Sub
ได้แก้ไขแล้วนะคะ และลอง run แล้วได้ผลแล้วค่ะ แต่ิติดว่าพอ add ข้อมุลไปแล้วและพอจะไปคลิกที่ ListBox เลยเพื่อดูรายการที่เรา add ไป แต่ค่าที่เพิ่ง add ไปยังไม่ขึ้น show ค่ะ จะ show เมื่อ กด exit แล้วเข้ามาดูใหม่ค่ะถึงจะ show ค่าที่เพิ่ง add ไปค่ะ ไม่ทราบว่าต้องปรับแก้ไข code ไหนคะ
ส่วนคำสั่ง Code ที่ทำหน้าที่ปรับคอลัมน์ Name ให้มี Format เป็น Text ต้องไปตั้ง code ที่ไหนคะ
ขอบคุณมากค่ะ
Re: Add value in ListBox
Posted: Wed Jan 18, 2012 4:45 pm
by snasui
ส่งไฟล์ที่ลองปรับแล้วมาด้วยครับ จะได้ช่วยทดสอบได้
Re: Add value in ListBox
Posted: Wed Jan 18, 2012 9:29 pm
by ANUSARA
ไฟล์ที่แก้ไขแล้วค่ะ
รบกวนช่วยดูด้วยนะคะ
ขอบคุณมากค่ะ
Re: Add value in ListBox
Posted: Wed Jan 18, 2012 10:17 pm
by snasui
ANUSARA wrote:แต่ติดว่าพอ add ข้อมูลไปแล้วและพอจะไปคลิกที่ ListBox เลยเพื่อดูรายการที่เรา add ไป แต่ค่าที่เพิ่ง add ไปยังไม่ขึ้น show
เนื่องจาก Code ไม่ถูกต้องครับ
ตัวอย่าง Code ในการเพิ่มรายการใน ListBox
สมมุติว่า เมื่อมีการกรอก TextBox8_Name_Body แล้ว Add รายการเข้าไปใน ListBox ดูได้ตามด้านล่างครับ
Code: Select all
Private Sub TextBox8_Name_Body_Change()
ListBox1_SelectNewRW.AddItem TextBox8_Name_Body
End Sub
ข้อควรระวังคือเมื่อไปคลิกใน ListBox อาจจะเกิด Error เพราะยังไม่มีค่านี้ในชีท UsEF_RW ลองปรับใช้กับการ Add รายการแล้วให้เพิ่มรายการเข้าไปใน ListBox ดู หากทำเช่นนี้จะสามารถคลิกรายการใน ListBox ที่เพิ่งเพิ่มเข้าไปได้ เพราะได้เพิ่มรายการใน UsEF_RW แล้ว
Re: Add value in ListBox
Posted: Wed Jan 18, 2012 10:56 pm
by ANUSARA
Code: Select all
Private Sub CommandButton7_Delete_Click()
Dim lng As Long
Answer = MsgBox("Are you sure you want to delete data from database?", 4 + 48, "Delete database")
If Answer = 6 Then
lng = Application.Match(ListBox1.Value, Worksheets("UsEF_RW").Range("E:E"), 0) 'บรรทัดนี้ขึ้น ERROR'
Worksheets("UsEF_RW").Rows(lng).Delete
Unload Me
ElseIf Answer = 7 Then
End If
End Sub
ลองเอา CODE ที่แนะนำไปวางแล้วค่ะ แต่ทำไมข้อมูลใน listbox มีช่องว่างห่างกันคะ ดูตามไฟล์ที่แนบค่ะ
และมี error ที่ code ของปุ่ม delete ค่ะ ไม่ทราบว่าผิดอะไรคะ
lng = Application.Match(ListBox1.Value, Worksheets("UsEF_RW").Range("E:E"), 0)
ขอบคุรมากค่ะ
Re: Add value in ListBox
Posted: Wed Jan 18, 2012 11:08 pm
by snasui
ช่วยบอกค่าข้อมูลที่ทดสอบด้วยครับ ช่องไหนคีย์ค่าใด และคลิกปุ่มใด
เท่าที่ดูเร็ว ๆ คือ Case เดิม
คือ Format ต่างกัน Vlookup, Match จะยึดถือ Format เป็นสำคัญในการค้นหาค่า
จากไฟล์ที่แล้วผมยังเห็น Format ยังปนกันเหมือนเดิม
ไม่มี Code ใดที่เข้ามาช่วยในการเปลี่ยน Format มีแต่การเพิ่ม Event ของการเปลี่ยนแปลง Control ต่าง ๆ แล้วให้ไป Vlookup ค่าใน Control นั้น ๆ ซึ่งเป็นการเขียน Code ซ้ำซ้อน แต่เมื่อใช้งานได้ก็เลยไม่ได้แจ้งไป Code ทีว่านี้คือตามด้านล่าง
Code: Select all
Private Sub TextBox14_SelectCF_Change()
TextBox14_SelectCF.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 6, False)
End Sub
Private Sub TextBox12_SelectSource_Change()
TextBox12_SelectSource.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 8, False)
End Sub
Private Sub TextBox11_SelectYear_Change()
TextBox11_SelectYear.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 9, False)
End Sub
Private Sub TextBox10_SelectLocation_Change()
TextBox10_SelectLocation.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 10, False)
End Sub
Private Sub TextBox9_SelectComment_Change()
TextBox9_SelectComment.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 11, False)
End Sub
Re: Add value in ListBox
Posted: Thu Jan 19, 2012 5:20 am
by ANUSARA
ค่ะ ไฟล์ที่แนบมาลองใส่ค่าตัวอย่าง
Name : test1
Carbon Footprint: 22
แล้วพอกด add data แล้วเพื่อให้แสดงข้อมูลใน input sheet และมากดที่ add to database และมากดดูที่ select data ที่จะ show ใน listbox
ค่าที่ add มาแสดงใน listbox แล้วค่ะ แต่แสดงเป็นแสดงเป็นแบบตัวอีกษรที่พิมพ์ตัวละ 1 บรรทัดค่ะ
เช่น t
te
tes
test
test1
แล้วพอคลิกเลือกค่าที่ test1 เพื่อดูค่า Carbon footprint ของค่า test1 มันก็error ที่ code ที่ listbox อีกค่ะ
ไม่ทราบว่าจะแก้ไขอย่างไรคะ
ขอบคุณค่ะ
Re: Add value in ListBox
Posted: Thu Jan 19, 2012 2:55 pm
by snasui
ผมทดสอบแล้วไม่มีปัญหาครับ โดยปรับ Code เป็นตามด้านล่าง
Code: Select all
'Private Sub TextBox14_SelectCF_Change()
''TextBox14_SelectCF.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 6, False)
'End Sub
'
'Private Sub TextBox12_SelectSource_Change()
'TextBox12_SelectSource.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 8, False)
'End Sub
'
'Private Sub TextBox11_SelectYear_Change()
'TextBox11_SelectYear.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 9, False)
'End Sub
'
'Private Sub TextBox10_SelectLocation_Change()
'TextBox10_SelectLocation.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 10, False)
'End Sub
'
'Private Sub TextBox9_SelectComment_Change()
'TextBox9_SelectComment.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 11, False)
'End Sub
Private Sub TextBox8_Name_Body_Change() 'Input data from TextBox8 (Name) to ListBox
'Dim rall As Range
'Dim r As Range
'With Sheets("UsEF_RW")
'Set rall = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
'End With
'For Each r In rall
'ListBox1_SelectNewRW.AddItem r ' Change lisbox1 to ListBox1
'Next r
'UserForm1.ListBox1.AddItem (UserForm1.TextBox8_Name.Text)
'Private Sub TextBox8_Name_Body_Change()
ListBox1_SelectNewRW.AddItem TextBox8_Name_Body
'End Sub
End Sub
สังเกตว่าผม Mark เป็น Comment สำหรับ Code ที่ไม่ต้องใช้ออกไปให้แล้ว
Re: Add value in ListBox
Posted: Thu Jan 19, 2012 4:25 pm
by ANUSARA
ลองแก้ code ตามแล้วค่ะ แต่ยัง error อยู่ค่ะ
สิ่งที่ยัง error อยู่คือ list รายการ เมื่อ add data name ว่า vv ค่าที่โชว์ใน listbox ก็แสดง v และ vv แยกกันเป็นสองบรรทัดค่ะ ต้องแก้ไขตรงไหนอีกบ้างคะ
Code: Select all
Private Sub ListBox1_SelectNewRW_Click()
With Worksheets("UsEF_RW")
TextBox14_SelectCF.Value = Application.VLookup(Me.ListBox1_SelectNewRW, .Range("E15:Q100"), 6, False) 'code นี้ ขึ้น error
TextBox12_SelectSource.Value = Application.VLookup(Me.ListBox1_SelectNewRW, .Range("E15:Q100"), 8, False)
TextBox11_SelectYear.Value = Application.VLookup(Me.ListBox1_SelectNewRW, .Range("E15:Q100"), 9, False)
TextBox10_SelectLocation.Value = Application.VLookup(Me.ListBox1_SelectNewRW, .Range("E15:Q100"), 10, False)
TextBox9_SelectComment.Value = Application.VLookup(Me.ListBox1_SelectNewRW, .Range("E15:Q100"), 11, False)
End With
End Sub
'Private Sub TextBox14_SelectCF_Change()
'TextBox14_SelectCF.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 6, False)
'End Sub
'Private Sub TextBox12_SelectSource_Change()
'TextBox12_SelectSource.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 8, False)
'End Sub
'Private Sub TextBox11_SelectYear_Change()
'TextBox11_SelectYear.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 9, False)
'End Sub
'Private Sub TextBox10_SelectLocation_Change()
'TextBox10_SelectLocation.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 10, False)
'End Sub
'Private Sub TextBox9_SelectComment_Change()
'TextBox9_SelectComment.Value = Application.VLookup(Me.ListBox1_SelectNewRW, Worksheets("UsEF_RW").Range("E15:Q100"), 11, False)
'End Sub
Private Sub TextBox8_Name_Body_Change() 'Input data from TextBox8 (Name) to ListBox
' Dim rall As Range
' Dim r As Range
' With Sheets("UsEF_RW")
' Set rall = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
' End With
' For Each r In rall
' ListBox1_SelectNewRW.AddItem r ' Change lisbox1 to ListBox1
' Next r
'UserForm1.ListBox1.AddItem (UserForm1.TextBox8_Name.Text)
'Private Sub TextBox8_Name_Body_Change()
ListBox1_SelectNewRW.AddItem TextBox8_Name_Body
'End Sub
End Sub
และปุ่ม delete พอคลิกแล้ว error ค่ะ
Code: Select all
Private Sub CommandButton7_Delete_Click()
Dim lng As Long
Answer = MsgBox("Are you sure you want to delete data from database?", 4 + 48, "Delete database")
If Answer = 6 Then
lng = Application.Match(ListBox1.Value, Worksheets("UsEF_RW").Range("E:E"), 0)
Worksheets("UsEF_RW").Rows(lng).Delete
Unload Me
ElseIf Answer = 7 Then
End If
End Sub
ขอบคุณมากค่ะ
Re: Add value in ListBox
Posted: Thu Jan 19, 2012 5:07 pm
by snasui
ที่ Procedure CommandButton1_AddEF_Click เปลี่ยน
Code: Select all
iRow = ws.Cells(Rows.Count, 13).End(xlUp).Offset(1, 0).Row
เป็น
Code: Select all
iRow = ws.Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).Row
เพื่อจะใช้คอลัมน์ 11 เป็นคอลัมน์อ้างอิง เนื่องจากมีค่าทุกบรรทัด การนับคอลัมน์ที่ 13 จะให้ค่าผิดพลาดเนื่องจากไม่ได้มีค่าทุกเซลล์ ยกเว้นเวลาทดสอบคีย์ค่าให้ครบทุก Control ก็สามารถให้คำตอบที่ถูกต้องได้เหมือนกัน
และปรับ Procedure CommandButton8_AddInputSh_Click เป็นตามด้านล่าง
Code: Select all
Private Sub CommandButton8_AddInputSh_Click()
With Worksheets("INPUT")
.Range("xAddRW1_Can") = UserForm1.TextBox8_Name_Body
.Range("xEF_AddData_Can") = UserForm1.TxtBox3_CF_Body
End With
ListBox1_SelectNewRW.AddItem TextBox8_Name_Body
End Sub
และลบ Procedure
TextBox8_Name_Body_Change ทิ้งไปหรือ Mark ให้เป็น Comment
ส่วนที่ลบไม่ได้เนื่องจากให้ชื่อ Control ไม่ถูกต้อง
ให้เปลี่ยน
Code: Select all
lng = Application.Match(ListBox1.Value, Worksheets("UsEF_RW").Range("E:E"), 0)
เป็น
Code: Select all
lng = Application.Match(ListBox1_SelectNewRW.Value, Worksheets("UsEF_RW").Range("E:E"), 0)
Re: Add value in ListBox
Posted: Sun Feb 05, 2012 4:22 pm
by ANUSARA
ทำตามที่แนะนำ ไม่มีปัญหาแล้วค่ะ
ขอบคุณมากค่ะ