Excel Forum

ฟอรัม Excel, VBA และอื่นๆ ของคนไทยเพื่อประโยชน์ของทุกคนในจักรวาล (Forum Excel, VBA and others of Thai people for everyone in the universe.)
https://snasui.com/

อยากทราบโค๊ดSelect listbox to sheet

https://snasui.com/viewtopic.php?t=16295

Page 1 of 1

อยากทราบโค๊ดSelect listbox to sheet

Posted: Fri Oct 25, 2019 1:06 pm
by boylee1928
รบกวนพี่ๆหน่อยครับอยากทราบโค๊ดการเลือกข้อมูลในListbox เเล้วสามารถลงหน้าSheetที่ต้องการได้
ตัวอย่างไฟล์ครับ
Book1.xlsm
ตัวอย่างรูปครับ
tset.JPG
โค๊ดที่ผมลองเขียนเเต่ยังไม่สามารถใช้งานได้ครับ

Code: Select all

Private Sub CommandButton1_Click()
Dim addme As Range, cNum As Integer
Dim x As Integer, y As Integer, Ck As Integer
Set addme = Sheet2.Cells(Rows.Count, 4).End(x1up).Offset(1, 0)
cNum = 7
Ck = 0
For x = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(x) Then
        Ck = 1
        For y = 0 To cNum
            addme.Offset(0, y) = Me.ListBox1.List(x, y)
        Next y
        Set addme = addme.Offset(1, 0)
    End If
    ListBox1.Selected(x) = False
Next x
    If Ck = 0 Then
        MsgBox "There is nothing Selected"
    End If

End Sub

Re: อยากทราบโค๊ดSelect listbox to sheet

Posted: Fri Oct 25, 2019 9:25 pm
by snasui
:D ผมทดสอบแล้วยังไม่สามารถคีย์ข้อความตามภาพแล้วแสดงค่าใน ListBox ได้ กรุณาแนบไฟล์ที่ Code ทำงานตามภาพได้แล้วมาใหม่ครับ

Re: อยากทราบโค๊ดSelect listbox to sheet

Posted: Sat Oct 26, 2019 8:05 pm
by boylee1928
Book1.xlsm
ตัวอย่างไฟล์เเละโค๊ดตามนี้ครับ

Code: Select all

Private Sub CommandButton1_Click()
Dim addme As Range, cNum As Integer
Dim x As Integer, y As Integer, Ck As Integer
Set addme = Sheet2.Cells(Rows.Count, 4).End(x1up).Offset(1, 0)
cNum = 7
Ck = 0
For x = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(x) Then
        Ck = 1
        For y = 0 To cNum
            addme.Offset(0, y) = Me.ListBox1.List(x, y)
        Next y
        Set addme = addme.Offset(1, 0)
    End If
    ListBox1.Selected(x) = False
Next x
    If Ck = 0 Then
        MsgBox "There is nothing Selected"
    End If

    
End Sub

Private Sub TextBox1_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For x = 1 To 7
     Me.ListBox1.List(0, x - 1) = Sheet1.Cells(1, x)
   Next x
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox1.Text)
If StrConv(Left(Sheet1.Cells(i, 1).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox1.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i
End Sub

Private Sub TextBox2_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For x = 1 To 7
     Me.ListBox1.List(0, x - 1) = Sheet1.Cells(1, x)
   Next x
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox2.Text)
If StrConv(Left(Sheet1.Cells(i, 2).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox2.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i

End Sub

Private Sub TextBox3_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For x = 1 To 7
     Me.ListBox1.List(0, x - 1) = Sheet1.Cells(1, x)
   Next x
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox3.Text)
If StrConv(Left(Sheet1.Cells(i, 3).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox3.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i
End Sub

Private Sub TextBox4_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For x = 1 To 7
     Me.ListBox1.List(0, x - 1) = Sheet1.Cells(1, x)
   Next x
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox4.Text)
If StrConv(Left(Sheet1.Cells(i, 4).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox4.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i
End Sub

Private Sub TextBox5_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For x = 1 To 7
     Me.ListBox1.List(0, x - 1) = Sheet1.Cells(1, x)
   Next x
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox5.Text)
If StrConv(Left(Sheet1.Cells(i, 5).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox5.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i
End Sub

Private Sub TextBox6_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For x = 1 To 7
     Me.ListBox1.List(0, x - 1) = Sheet1.Cells(1, x)
   Next x
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox6.Text)
If StrConv(Left(Sheet1.Cells(i, 6).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox6.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i
End Sub

Private Sub TextBox7_Change()
Dim i As Long
ListBox1.Clear
Me.ListBox1.AddItem
   For x = 1 To 7
     Me.ListBox1.List(0, x - 1) = Sheet1.Cells(1, x)
   Next x
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
a = Len(Me.TextBox7.Text)
If StrConv(Left(Sheet1.Cells(i, 7).Value, a), vbLowerCase) = StrConv(Left(Me.TextBox7.Text, a), vbLowerCase) Then
Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
End If
Next i

End Sub

Re: อยากทราบโค๊ดSelect listbox to sheet

Posted: Sat Oct 26, 2019 8:38 pm
by snasui
:D ปรับ Code ที่ Procedure CmmmandButton1_Click จาก

Set addme = Sheet2.Cells(Rows.Count, 4).End(x1Up).Offset(1, 0) เป็น Set addme = Sheet2.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)

Code ผิดตรง xlUp ครับ

Re: อยากทราบโค๊ดSelect listbox to sheet

Posted: Sun Oct 27, 2019 12:04 pm
by boylee1928
ขอบคุณมากครับ
All times are UTC+07:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited