انتقال اطلاعات از لیست باکس به کامبو باکس

Collapse
X
Collapse
 
  • صفحه از 1
  • زمان
  • نمایش
حذف همه
new posts
قبلی template بعدی
  • nimak2

    • 2021/07/24
    • 5
    #1

    پرسش انتقال اطلاعات از لیست باکس به کامبو باکس

    سلام خدمت اساتید محترم

    لطفا اساتید راهنمایی فرمایند

    1 . یک لیست باکس که اطلاعات درون آن نمایش داده شود . ( اطلاعات درون شیت دیگری است)
    2 . لیست باکس قابلیت سرچ کردن داشته باشد.
    2.1 انتخواب کردن نوع سرچ (درون کامبو باکس ) و سرچ کردن (درون تکست باکس).
    3. انتخواب کردن اطلاعات نمایش داده شده در لیست باکس و درج شدن در کامبوباکس مورد نظر.

    * کامبوباکس ها به هم مرتبط هستن و اطلاعات مرتبط به هم و طبقه بندی شده نمایش می دهند.
    * کد نوشته شده در پایین درج شده است ( کدی که برای این پروژه نوشته شده است ).
    * متاسفانه این کد مشکل دارد و اطلاعات رو در لیست باکس به نمایش در نمی آورد و سرچ هم نمی کند .

    1. [*=left]
      کد:
      Option Explicit
[*=left]
[*=left]
[*=left]Private Sub CommandButton3_click()
[*=left]Dim Rng As Range
[*=left]Dim Rng1 As Range
[*=left]If TextBox1.Text = "" Or TextBox2.Text = "" Or ComboBox3.Text = "" Or ComboBox4.Text = "" Or ComboBox5.Text = "" Or ComboBox6.Text = "" Or ComboBox7.Text = "" Or ComboBox8.Text = "" Or TextBox9.Text = "" Or TextBox10.Text = "" Then
[*=left]MsgBox "áØÝÇ ÊãÇã ÇØáÇÚÇÊ ÎæÇÓÊå ÔÏå ÑÇ Ê˜ãíá äãÇííÏ "
[*=left]Exit Sub
[*=left]ElseIf Not IsNumeric(TextBox1.Text) Then
[*=left]MsgBox "ÑÏíÝ Èå ÕæÑÊ ÚÏÏ æÇÑÏ ÔæÏ "
[*=left]Exit Sub
[*=left]
[*=left]
[*=left]End If
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]For Each Rng In Range("b7:b99999")
[*=left]If Rng = "" Then
[*=left]Rng.Offset(0, 0) = TextBox1.Text
[*=left]Rng.Offset(0, 1) = TextBox2.Text
[*=left]Rng.Offset(0, 2) = ComboBox3.Text
[*=left]Rng.Offset(0, 3) = ComboBox4.Text
[*=left]Rng.Offset(0, 4) = ComboBox5.Text
[*=left]Rng.Offset(0, 5) = ComboBox6.Text
[*=left]Rng.Offset(0, 6) = ComboBox7.Text
[*=left]Rng.Offset(0, 7) = ComboBox8.Text
[*=left]Rng.Offset(0, 8) = TextBox9.Text
[*=left]Rng.Offset(0, 9) = TextBox10.Text
[*=left]Exit For
[*=left]End If
[*=left]Next Rng
[*=left]
[*=left]
[*=left]TextBox1.Text = ""
[*=left]TextBox2.Text = ""
[*=left]ComboBox3.Text = ""
[*=left]ComboBox4.Text = ""
[*=left]ComboBox5.Text = ""
[*=left]ComboBox6.Text = ""
[*=left]ComboBox7.Text = ""
[*=left]ComboBox8.Text = ""
[*=left]TextBox9.Text = ""
[*=left]TextBox10.Text = ""
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Cells.Interior.ColorIndex = 0
[*=left]
[*=left]
[*=left]End Sub
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Private Sub CommandButton4_Click()
[*=left]On Error GoTo Err
[*=left]TextBox2.Text = Application.WorksheetFunction.VLookup(Val(TextBox1.Text), Worksheets("Contractor").Range("b:k"), 2, False)
[*=left]ComboBox3.Text = Application.WorksheetFunction.VLookup(Val(TextBox1.Text), Worksheets("Contractor").Range("b:k"), 3, False)
[*=left]ComboBox4.Text = Application.WorksheetFunction.VLookup(Val(TextBox1.Text), Worksheets("Contractor").Range("b:k"), 4, False)
[*=left]ComboBox5.Text = Application.WorksheetFunction.VLookup(Val(TextBox1.Text), Worksheets("Contractor").Range("b:k"), 5, False)
[*=left]ComboBox6.Text = Application.WorksheetFunction.VLookup(Val(TextBox1.Text), Worksheets("Contractor").Range("b:k"), 6, False)
[*=left]ComboBox7.Text = Application.WorksheetFunction.VLookup(Val(TextBox1.Text), Worksheets("Contractor").Range("b:k"), 7, False)
[*=left]ComboBox8.Text = Application.WorksheetFunction.VLookup(Val(TextBox1.Text), Worksheets("Contractor").Range("b:k"), 8, False)
[*=left]TextBox9.Text = Application.WorksheetFunction.VLookup(Val(TextBox1.Text), Worksheets("Contractor").Range("b:k"), 9, False)
[*=left]TextBox10.Text = Application.WorksheetFunction.VLookup(Val(TextBox1.Text), Worksheets("Contractor").Range("b:k"), 10, False)
[*=left]
[*=left]
[*=left]Dim Rng1 As Range
[*=left]    For Each Rng1 In Range("b7:b99999")
[*=left]        If TextBox1.Text = Rng1 Then
[*=left]        Rng1.EntireRow.Interior.ColorIndex = 15
[*=left]    End If
[*=left]Next Rng1
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Exit Sub
[*=left]
[*=left]
[*=left]Err:
[*=left]
[*=left]
[*=left]MsgBox "Çíä ˜Ï ˜ÇáÇ æÌæÏ äÏÇÑÏ "
[*=left]
[*=left]
[*=left]TextBox1.Text = ""
[*=left]TextBox2.Text = ""
[*=left]ComboBox3.Text = ""
[*=left]ComboBox4.Text = ""
[*=left]ComboBox5.Text = ""
[*=left]ComboBox6.Text = ""
[*=left]ComboBox7.Text = ""
[*=left]ComboBox8.Text = ""
[*=left]TextBox9.Text = ""
[*=left]TextBox10.Text = ""
[*=left]
[*=left]
[*=left]End Sub
[*=left]
[*=left]
[*=left]Private Sub CommandButton5_Click()
[*=left]TextBox1.Text = ""
[*=left]TextBox2.Text = ""
[*=left]ComboBox3.Text = ""
[*=left]ComboBox4.Text = ""
[*=left]ComboBox5.Text = ""
[*=left]ComboBox6.Text = ""
[*=left]ComboBox7.Text = ""
[*=left]ComboBox8.Text = ""
[*=left]TextBox9.Text = ""
[*=left]TextBox10.Text = ""
[*=left]
[*=left]
[*=left]Cells.Interior.ColorIndex = 0
[*=left]End Sub
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Private Sub CommandButton6_Click()
[*=left]Cells.Interior.ColorIndex = 0
[*=left]Unload Me
[*=left]
[*=left]
[*=left]End Sub
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Private Sub CommandButton7_Click()
[*=left]Dim rng2 As Range
[*=left]
[*=left]
[*=left]For Each rng2 In Range("b7:b99999")
[*=left]If rng2 = TextBox1.Text Then
[*=left]rng2.Offset(0, 1) = TextBox2.Text
[*=left]rng2.Offset(0, 2) = ComboBox3.Text
[*=left]rng2.Offset(0, 3) = ComboBox4.Text
[*=left]rng2.Offset(0, 4) = ComboBox5.Text
[*=left]rng2.Offset(0, 5) = ComboBox6.Text
[*=left]rng2.Offset(0, 6) = ComboBox7.Text
[*=left]rng2.Offset(0, 7) = ComboBox8.Text
[*=left]rng2.Offset(0, 8) = TextBox9.Text
[*=left]rng2.Offset(0, 9) = TextBox10.Text
[*=left]End If
[*=left]Next
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Cells.Interior.ColorIndex = 0
[*=left]
[*=left]
[*=left]End Sub
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Private Sub CommandButton8_Click()
[*=left]Sheets("Input_materials").Select
[*=left]Cells.Interior.ColorIndex = 0
[*=left]Unload Me
[*=left]Input_materials.Show
[*=left]End Sub
[*=left]
[*=left]
[*=left]Private Sub CommandButton9_Click()
[*=left]Sheets("activities").Select
[*=left]Cells.Interior.ColorIndex = 0
[*=left]Unload Me
[*=left]activities.Show
[*=left]End Sub
[*=left]
[*=left]
[*=left]Private Sub combobox3_Change()
[*=left]Me.ComboBox4.Clear
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Dim sh As Worksheet
[*=left]Set sh = Sheets("data")
[*=left]
[*=left]
[*=left]Dim i As Long
[*=left]For i = 2 To sh.Range("F99999").End(xlUp).Row
[*=left]If sh.Cells(i, 6) = Me.ComboBox3.Value Then
[*=left]If Application.WorksheetFunction.CountIf(sh.Range("G2", "G" & i), sh.Cells(i, 7)) = 1 Then
[*=left]
[*=left]
[*=left]Me.ComboBox4.AddItem sh.Cells(i, 7)
[*=left]End If
[*=left]End If
[*=left]Next i
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]End Sub
[*=left]
[*=left]
[*=left]Private Sub combobox4_Change()
[*=left]Me.ComboBox5.Clear
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Dim sh As Worksheet
[*=left]Set sh = Sheets("data")
[*=left]
[*=left]
[*=left]Dim i As Long
[*=left]For i = 2 To sh.Range("F99999").End(xlUp).Row
[*=left]If sh.Cells(i, 7) = Me.ComboBox4.Value Then
[*=left]If Application.WorksheetFunction.CountIf(sh.Range("H2", "H" & i), sh.Cells(i, 8)) = 1 Then
[*=left]Me.ComboBox5.AddItem sh.Cells(i, 8)
[*=left]End If
[*=left]End If
[*=left]Next i
[*=left]
[*=left]
[*=left]End Sub
[*=left]Private Sub ComboBox5_Change()
[*=left]Me.ComboBox6.Clear
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Dim sh As Worksheet
[*=left]Set sh = Sheets("data")
[*=left]
[*=left]
[*=left]Dim i As Long
[*=left]For i = 2 To sh.Range("F99999").End(xlUp).Row
[*=left]If sh.Cells(i, 8) = Me.ComboBox5.Value Then
[*=left]Me.ComboBox6.AddItem sh.Cells(i, 9)
[*=left]End If
[*=left]Next i
[*=left]
[*=left]
[*=left]End Sub
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
[*=left]
[*=left]
[*=left]On Error GoTo ListBox1_DblClick_Error
[*=left]Me.CommandButton3.Enabled = False
[*=left]Me.CommandButton7.Enabled = True
[*=left]Me.CommandButton5.Enabled = True
[*=left]Me.ComboBox3.Value = Me.ListBox1.Column(1)
[*=left]Me.ComboBox4.Value = Me.ListBox1.Column(2)
[*=left]Me.ComboBox5.Value = Me.ListBox1.Column(3)
[*=left]Me.ComboBox6.Value = Me.ListBox1.Column(4)
[*=left]conInfoBox.BackColor = &H2E3FED
[*=left]ListBox1.Enabled = False
[*=left]On Error GoTo 0
[*=left]Exit Sub
[*=left]
[*=left]
[*=left]ListBox1_DblClick_Error:
[*=left]MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ListBox1_DblClick of Form PhoneList"
[*=left]End Sub
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Private Sub txtSearch_Change()
[*=left]Dim sat, s As Integer
[*=left]Dim deg1, deg2 As String
[*=left]Dim sh As Worksheet
[*=left]Set sh = Sheets("data")
[*=left]
[*=left]
[*=left]If cboSelect.Value = "" Then
[*=left]MsgBox "áØÝÇ í˜ ÝíáÊÑ ÈÑÇí ÌÓÊÌæ ÇäÊÎÇÈ ˜äíÏ", vbCritical, "Error"
[*=left]cboSelect.SetFocus
[*=left]Exit Sub
[*=left]End If
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]With ListBox1
[*=left].Clear
[*=left].ColumnCount = 5
[*=left]End With
[*=left]
[*=left]
[*=left]deg2 = txtSearch.Value
[*=left]
[*=left]
[*=left]Select Case cboSelect.Value
[*=left]
[*=left]
[*=left]Case "ÑÏå íãÇä˜ÇÑí"
[*=left]For sat = 2 To Cells("D").End(xlUp).Row
[*=left]Set deg1 = Cells(sat, "D")
[*=left]If UCase(deg1) Like UCase(deg2) & "*" Then
[*=left]ListBox1.AddItem
[*=left]ListBox1.List(s, 3) = Cells(sat, "D")
[*=left]ListBox1.List(s, 4) = Cells(sat, "E")
[*=left]ListBox1.List(s, 5) = Cells(sat, "F")
[*=left]ListBox1.List(s, 6) = Cells(sat, "G")
[*=left]
[*=left]
[*=left]s = s + 1
[*=left]End If: Next
[*=left]
[*=left]
[*=left]Case "íãÇä˜ÇÑ"
[*=left]For sat = 2 To Cells("E").End(xlUp).Row
[*=left]Set deg1 = Cells(sat, "E")
[*=left]If UCase(deg1) Like UCase(deg2) & "*" Then
[*=left]ListBox1.AddItem
[*=left]ListBox1.List(s, 3) = Cells(sat, "D")
[*=left]ListBox1.List(s, 4) = Cells(sat, "E")
[*=left]ListBox1.List(s, 5) = Cells(sat, "F")
[*=left]ListBox1.List(s, 6) = Cells(sat, "G")
[*=left]
[*=left]
[*=left]s = s + 1
[*=left]End If: Next
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Case " äÇã äÝÑÇÊ"
[*=left]For sat = 2 To Cells("F").End(xlUp).Row
[*=left]Set deg1 = Cells(sat, "F")
[*=left]If UCase(deg1) Like UCase(deg2) & "*" Then
[*=left]ListBox1.AddItem
[*=left]ListBox1.List(s, 3) = Cells(sat, "D")
[*=left]ListBox1.List(s, 4) = Cells(sat, "E")
[*=left]ListBox1.List(s, 5) = Cells(sat, "F")
[*=left]ListBox1.List(s, 6) = Cells(sat, "G")
[*=left]
[*=left]
[*=left]s = s + 1
[*=left]End If: Next
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Case "ÍÑÝå"
[*=left]
[*=left]
[*=left]For sat = 2 To Cells("G").End(xlUp).Row
[*=left]Set deg1 = Cells(sat, "G")
[*=left]If UCase(deg1) Like UCase(deg2) & "*" Then
[*=left]ListBox1.AddItem
[*=left]ListBox1.List(s, 3) = Cells(sat, "D")
[*=left]ListBox1.List(s, 4) = Cells(sat, "E")
[*=left]ListBox1.List(s, 5) = Cells(sat, "F")
[*=left]ListBox1.List(s, 6) = Cells(sat, "G")
[*=left]
[*=left]
[*=left]s = s + 1
[*=left]End If: Next
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]End Select
[*=left]End Sub
[*=left]Private Sub cmdContact_Click()
[*=left]Dim DataSH As Worksheet
[*=left]On Error GoTo errhandler:
[*=left]
[*=left]
[*=left]ListBox1.List = Sheets("Contractor").Range("b7:k" & [b65536].End(3).Row).Value
[*=left]
[*=left]
[*=left]On Error GoTo 0
[*=left]Exit Sub
[*=left]errhandler:
[*=left]MsgBox "äÊíÌå Çí íÇÝÊ äÔÏ ÈÑÇí " & txtSearch.Text
[*=left]End Sub
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Private Sub UserForm_Initialize()
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]Dim sh As Worksheet
[*=left]Set sh = Sheets("data")
[*=left]
[*=left]
[*=left]Dim i As Long
[*=left]For i = 2 To sh.Range("F10000").End(xlUp).Row
[*=left]If Application.WorksheetFunction.CountIf(sh.Range("F2", "F" & i), sh.Cells(i, 6)) = 1 Then
[*=left]Me.ComboBox3.AddItem sh.Cells(i, 6)
[*=left]End If
[*=left]Next i
[*=left]
[*=left]
[*=left]Set sh = Sheets("activities")
[*=left]
[*=left]
[*=left]Dim N As Long
[*=left]For N = 2 To sh.Range("E10000").End(xlUp).Row
[*=left]If Application.WorksheetFunction.CountIf(sh.Range("E2", "E" & N), sh.Cells(N, 5)) = 1 Then
[*=left]Me.ComboBox7.AddItem sh.Cells(N, 5)
[*=left]End If
[*=left]Next N
[*=left]
[*=left]
[*=left]
[*=left]
[*=left]For i = 2 To 5
[*=left]Contractor.cboSelect.AddItem (Sheets("Contractor").Cells(1, i))
[*=left] Next
[*=left]With ListBox1
[*=left].ColumnCount = 5
[*=left]End With
[*=left]With ListBox2
[*=left].ColumnCount = 5
[*=left].List = Sheets("Contractor").Range("D6:G6").Value
[*=left]End With
[*=left]
[*=left]
[*=left]End Sub
[*=left]
[*=left]
[*=left]Private Sub ComboBox7_Change()
[*=left]Me.ComboBox8.Clear
[*=left]
[*=left]
[*=left]Dim sh As Worksheet
[*=left]Set sh = Sheets("activities")
[*=left]
[*=left]
[*=left]Dim N As Long
[*=left]For N = 2 To sh.Range("E10000").End(xlUp).Row
[*=left]If sh.Cells(N, 5) = Me.ComboBox7.Value Then
[*=left]If Application.WorksheetFunction.CountIf(sh.Range("F2", "F" & N), sh.Cells(N, 6)) = 1 Then
[*=left]
[*=left]
[*=left]Me.ComboBox8.AddItem sh.Cells(N, 6)
[*=left]End If
[*=left]End If
[*=left]Next N
[*=left]
[*=left]
[*=left]End Sub
[*=left]





    فایل های پیوست شده
    Last edited by nimak2; 2021/09/08, 14:36.
    برچسب ها: هیچ‌کدام
    قبلی template بعدی
    چند لحظه..