اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

السلام عليكم

سيصبح الكود بهذه الطريقة مع الملاحظة ان البحث سيكون حسب العمود L

Private Sub ButtonFind_Click()

Dim Ary()
Dim i As Integer, ii As Integer, Lr As Integer
Dim dt1 As Double, dt2 As Double
Dim ib As Boolean
Me.ListBox1.Clear
With Sheet1
    Lr = .Cells(.Rows.Count, "a").End(xlUp).Row
    If IsDate(Me.TextDate1) Then dt1 = CDate(Me.TextDate1) Else dt1 = WorksheetFunction.Min(.Range("E3").Resize(Lr)): Me.TextDate1 = Format(dt1, DateFormt)
    If IsDate(Me.TextDate2) Then dt2 = CDate(Me.TextDate2) Else dt2 = WorksheetFunction.Max(.Range("E3").Resize(Lr)): Me.TextDate2 = Format(dt2, DateFormt)
    For i = 3 To Lr
        Select Case .Cells(i, "E").Value2: Case dt1 To dt2
        If InStr(1, .Cells(i, "L"), Me.TextFind, vbTextCompare) = 1 Then
                ii = ii + 1
                ReDim Preserve Ary(1 To Cont, 1 To ii)
                Ary(1, ii) = .Cells(i, 1).Value
                Ary(2, ii) = .Cells(i, 2).Value
                Ary(3, ii) = .Cells(i, 3).Value
                Ary(4, ii) = .Cells(i, 4).Value
                Ary(5, ii) = .Cells(i, 11).Value
                Ary(6, ii) = .Cells(i, 6).Value
                Ary(7, ii) = .Cells(i, 7).Value
                Ary(8, ii) = .Cells(i, 8).Value
                Ary(9, ii) = .Cells(i, 9).Value
                Ary(10, ii) = .Cells(i, 10).Value
                Ary(11, ii) = Format(.Cells(i, 5).Value, DateFormt)
                Ary(12, ii) = .Cells(i, 12).Value
            End If
        End Select
    Next
End With
If ii Then Me.ListBox1.Column = Ary
Erase Ary
End Sub

Private Sub UserForm_Initialize()
Me.TextFind = "A"
End Sub

قام بنشر

اخى ابو حنين

مشكورا على الاهتمام والرد

بارك الله فيك

ولكن ليس هذا ما اريده

طلبى

هو عند فتح الفوم

لايظهر فى الليست بوكس

الا البيانات الخاصه

بحرف A

الموجود فى العمود الاخير

وذلك عن طريق الكود الموضوع فى

Private Sub UserForm_Activate()

قام بنشر

في هذه الحالة

تضيف هذا الكود

Sub sFind_A()

Dim Ary()
Dim i As Integer, ii As Integer, Lr As Integer
Me.ListBox1.Clear
With Sheet1
    Lr = .Cells(.Rows.Count, "a").End(xlUp).Row
    For i = 3 To Lr
        If InStr(1, .Cells(i, "L"), "A", vbTextCompare) = 1 Then
                ii = ii + 1
                ReDim Preserve Ary(1 To Cont, 1 To ii)
                Ary(1, ii) = .Cells(i, 1).Value
                Ary(2, ii) = .Cells(i, 2).Value
                Ary(3, ii) = .Cells(i, 3).Value
                Ary(4, ii) = .Cells(i, 4).Value
                Ary(5, ii) = .Cells(i, 11).Value
                Ary(6, ii) = .Cells(i, 6).Value
                Ary(7, ii) = .Cells(i, 7).Value
                Ary(8, ii) = .Cells(i, 8).Value
                Ary(9, ii) = .Cells(i, 9).Value
                Ary(10, ii) = .Cells(i, 10).Value
                Ary(11, ii) = Format(.Cells(i, 5).Value, DateFormt)
                Ary(12, ii) = .Cells(i, 12).Value
            End If
    Next
End With
If ii Then Me.ListBox1.Column = Ary
Erase Ary
End Sub

ثم في الحدث    UserForm_Activate

Private Sub UserForm_Activate()
ListBox1.ColumnCount = Cont
sFind_A
End Sub

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
×
×
  • اضف...

Important Information