بحث بمعلومية خلية وسرد البيانات المطابقة

[محمود ربيع]

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

اساتذتنا الكرام عندما تتعثر قدامي فلا مجال لي الا اللجوء لله اولا واخيرا ثم  لاساتذتي بارك الله فيكم

ارجو مساعدتي في المطلوب التالي :

عند كتابة اسم الامر في الخلية H3 يتم البحث في النطاق ( Sheet1!A2 :D10000 ) في العمود ( C )عن اي خامة دخلت في تكوين الامر وتكتب هذه الخامات بترتيبها "في النطاق ( H ) اياً كان عدد الخامات الداخلة "بداية من الخلية ( H5 ) كما يكتب امام اسم الخامة تكلفتها من العمود Sheet1!(D2:D10000)  (((( ويكون ربط البحث بالخلية H3  بشكل متغير ))))  حيث كلما تم تغير اسم الامر يتم البحث عن البيانات الخاصة به بمعلومية تاريخين تاريخ من وتاريخ الي .

ملخص المطلوب :

1- سرد كافة الخامات من sheet1!(A2:D10000)  التي تندرج تحت امر التشغيل المكتوب في الخلية  H3  اسفل الخلية المكتوب فيها ( اسم الخامة ) ويحبذ لو تم عمل تنسيق شرطي ضمن محتويات الكود برسم اطار جدول للخلايا الممتلئة بالبيانات فقط .

2- ان تكون الخامات واقعة بين التاريخين من والي ( اكبر من او تساوي التاريخ من واقل من او تساوي التاريخ الي ) والشرح واضح داخل الملف المرفق ....

ولكم جزيل الشكر اساتذتنا الكرام وجزاكم الله خيرا

بحث وسرد البيانات المطلوبة.zip

[أم عبد الله]

الأستاذ / modi basha

 

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

 

إليك الملف لعله المطلوب.

بحث وسرد.rar

[محمود ربيع]

الاخت الكريمة ام عبد الله جزاك الله كل خير عمل جميل - ولكن انا لا اريد استخدام المعادلات لان البيانات سوف يتم استخدامها علي نطاق واسع جدا مما سيؤدي الي ضخامة حجم الملف ومرة اخري جزاك الله كل خيرا اختي الكريمة

[عبدالله باقشير]

السلام عليكم

'     عدد الاعمدة
Private Const Cont As Integer = 2


Sub kh_Find()
Dim Ary()
Dim i As Long, ii As Long, Lr As Long
Dim dt1 As Double, dt2 As Double
Dim txt As String


Lr = Cells(Rows.Count, "H").End(xlUp).Row
If Lr > 4 Then Range("H5:I" & Lr).ClearContents

On Error GoTo 1

txt = [H3]
dt1 = [I3]
dt2 = [J3]

With ورقة1
    Lr = .Cells(.Rows.Count, "a").End(xlUp).Row
    For i = 2 To Lr
        Select Case .Cells(i, "B").Value2: Case dt1 To dt2
            If InStr(CStr(.Cells(i, "A")), txt) Then
                ii = ii + 1
                ReDim Preserve Ary(1 To Cont, 1 To ii)
                Ary(1, ii) = .Cells(i, "C").Value
                Ary(2, ii) = .Cells(i, "D").Value
            End If
        End Select
    Next
End With

If ii Then Range("H5").Resize(ii, Cont).Value = WorksheetFunction.Transpose(Ary)
1
Erase Ary
End Sub

المرفق 2010

بحث وسرد.rar

[محمود ربيع]

استاذي العلامة / عبد الله باقشير

لي الشرف والفخر بان يرد العلامة علي موضوع خاص بي بل وهذا يخجلني والله .

جزاك الله عنا كل خير وزادك من علمه عمل رائع بكل ما في الكلمة من معني

ارجوك تقبل تحياتي .

[إبراهيم ابوليله]

اخى واستاذنا عبدالله

بارك الله فيك كود فى

غايه البساطه والاتقان

وهذا ما تعودناه منك

نسأل الله الا يحرمنا منك