طلب طريقة اظهار الاعمده في الليست بوكس يفصل بين البيانات

[محمد عبدالسلام]

السلام عليكم و حمة الله و بركاته

 

طلب طريقة اظهار الاعمده في الليست بوكس  يفصل بين البيانات

 

اظهار الاعمده في الليست بوكس.zip

تم تعديل يونيو 2, 2016 بواسطه محمد عبدالسلام

[ياسر العربى]

تفضل وهي طريقة للتحايل فقط وليست ضمن خيارات الليست بوكس

 

اظهار الاعمده في الليست بوكس.rar

 

[محمد عبدالسلام]

 

السلام عليكم و حمة الله و بركاته

مشكور اخي ياسر العربي  بارك الله فيك على المساعدة ارجو منك لو سمحت اريد منك اضافة طريقة في هدالكود  يبدو ان الملف لي رفعت ليس مطابق الملف الأصلي لدي

 

 

 

 

 

 

'كود الليست بوكس

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
Dim Rng As Range, LR As Long
Dim x, y, z
'x = InputBox("Please enter a Quantity")
UserForm5.Show
x = UserForm5.TextBox1.Value
y = UserForm5.TextBox2.Value
z = UserForm5.TextBox3.Value
Unload UserForm5
If x = False Or StrPtr(x) = 0 Or Not IsNumeric(x) Then
Exit Sub
Else
LR = Sheet1.Cells(Rows.Count, "E").End(xlUp).Row + 1
Set Rng = Sheet1.Cells(LR, 4)
    
If ListBox1.Value <> "" Then
Rng.Value = ListBox1.Value
Rng.Offset(0, 1).Value = y
Rng.Offset(0, 2).Value = x
Rng.Offset(0, 3).Value = ListBox1.List(ListBox1.ListIndex, 2)
Rng.Offset(0, 4).Value = z

End If
TextFind.SelStart = 0
TextFind.SelLength = Len(TextFind.Text)
TextFind.SetFocus
End If
End If
End Sub

 

'كود البحت
Private Sub TextFind_Change()
Dim MyValue
Dim MyAr() As String
Dim R As Integer, I As Integer, ii As Integer
Dim MyColmnFind As Integer, LastRow As Integer

MyColmnFind = Me.ComboBox1.ListIndex + 1
If MyColmnFind = 0 Then Exit Sub
If MyColmnFind = 3 Then Me.TextFind = ""
Me.ListBox1.Clear
With Rng.Worksheet
  LastRow = .Range("A65536").End(xlUp).Row
End With
Colmn = ""
With Rng
    For R = 2 To LastRow
             If .Cells(R, MyColmnFind) Like "*" & TextFind & "*" Then
                Colmn = Colmn & R & " "
                ii = ii + 1
                ReDim Preserve MyAr(1 To ContColmn, 1 To ii)
                For I = 1 To ContColmn
                    MyValue = .Cells(R, I).Value2
                    MyAr(I, ii) = MyValue
                Next
            End If
       
    Next
End With
If ii Then Me.ListBox1.Column = MyAr: Me.ListBox1.ListIndex = 0
End Sub

 

تم تعديل يونيو 2, 2016 بواسطه محمد عبدالسلام

[ياسر العربى]

يرجى رفع الملف حتى تتضح الامور لنا

وشكرا

[محمد عبدالسلام]

رفع