اريد استدعاء بيانات بين تاريخيين

[محمد الورفلي1]

السلام عليكم

 

اريد استدعاء بيانات بين تاريخيين

 

استدعاء بين تاريخيين..rar

[محمد الورفلي1]

للرفع

[سليم حاصبيا]

جرب هذا الملف

 

استدعاء بين تاريخيين. Salim.rar

[محمد الورفلي1]

لو سمحت يكون بالكود من فضلك

[ابراهيم الحداد]

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

استخدم هذا الكود

Sub CallingData()
Dim ws As Worksheet, sh As Worksheet
Dim Arr As Variant, Temp As Variant
Dim i As Long, j As Long, p As Long
Set ws = Sheets("ورقة1")
Set sh = Sheets("ورقة2")
Arr = ws.Range("A13:O72").Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 3) >= sh.Range("Q7") And Arr(i, 3) <= sh.Range("R7") Then
p = p + 1
For j = 1 To UBound(Arr, 2)
Temp(p, j) = Arr(i, j)
Next
End If
Next
sh.Range("A11").Resize(p, UBound(Temp, 2)).Value = Temp
End Sub

 

[محمد الورفلي1]

شكراً استاذ زيزو

ممتاز جداَ

 

اريد شرح للكود لانه بصراحة وبدون مبالغة خفيف جداً وسريع واريد ان استخدمة في ملف اخر   اكن شاكر لك

[ابراهيم الحداد]

السلام عليكم ورحمة الله
الحمد لله على تمام المطلوب
اليك اخى شرح الكود
 

Sub CallingData()
Dim ws As Worksheet, sh As Worksheet
الاعلان عن اسماء الشيتات التى سوف يتم التعامل معها
Dim Arr As Variant, Temp As Variant
'الاعلان عن مصفوفتين احدهما هى المصدر و الاخرى للنتائج المطلوبة
Dim i As Long, j As Long, p As Long
'الاعلان عن طول وعرض المصفوفة وعدد النتائج'
Set ws = Sheets("ورقة1")
Set sh = Sheets("ورقة2")
'التعريف بالشيت الاول والشيت الثانى'
Arr = ws.Range("A13:O72").Value
'التعريف بالمصفوفة المصدر
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
'التعريف بالمصفوفة الهدف وعلاقتها بالمصفوفة المصدر'
For i = 1 To UBound(Arr, 1)
طول المصفوفة المصدر'
If Arr(i, 3) >= sh.Range("Q7") And Arr(i, 3) <= sh.Range("R7") Then
'الشرط الذى سوف يتم بناء عليه اختيار عناصر المصفوفة الهدف
p = p + 1
'عد بيانات الشرط'
For j = 1 To UBound(Arr, 2)
'عرض المصفوفة الهدف وهو هنا نفس عرض المصفوفة المصدر'
Temp(p, j) = Arr(i, j)
'الاستكمال النهائى للمصفوفة الهدف'
Next
End If
Next
sh.Range("A11").Resize(p, UBound(Temp, 2)).Value = Temp
'ترحيل المصفوفة الهدف الى المكان المراد اظهار البيانات فيه'
End Sub

 

تم تعديل أكتوبر 29, 2017 بواسطه زيزو العجوز

[محمد الورفلي1]

شكراً استاذ زيزو

تم تعديل أكتوبر 28, 2017 بواسطه محمد الخازمي

[سليم حاصبيا]

بعد اذن اخي زيزو هذا الكود باستعمال Advanced Filter 

انه اسرع و بدون حلقات تكرارية

انظر الى الصفحة Salim

 

استدعاء بين تاريخيين. Salim1.rar