Add value in ListBox

[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 ที่ไหนคะ

ขอบคุณมากค่ะ

[snasui]

ส่งไฟล์ที่ลองปรับแล้วมาด้วยครับ จะได้ช่วยทดสอบได้

[ANUSARA]

ไฟล์ที่แก้ไขแล้วค่ะ

รบกวนช่วยดูด้วยนะคะ

ขอบคุณมากค่ะ

[snasui]

แต่ติดว่าพอ 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 แล้ว

[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)

ขอบคุรมากค่ะ

[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

[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 อีกค่ะ

ไม่ทราบว่าจะแก้ไขอย่างไรคะ
ขอบคุณค่ะ

[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 ที่ไม่ต้องใช้ออกไปให้แล้ว

[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

ขอบคุณมากค่ะ

[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)

[ANUSARA]

ทำตามที่แนะนำ ไม่มีปัญหาแล้วค่ะ
ขอบคุณมากค่ะ