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

جلب بيانات بين تاريخين


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

4 ساعات مضت, سليم حاصبيا said:

ربما ينال الاعجاب هذا الملف (بدون كود)

 

 

السلام عليكم اعجبني لكن اريده بالكود  استاذ سليم

تم تعديل بواسطه محمد الخازمي
رابط هذا التعليق
شارك

ولإثراء الموضوع 

وبعد اذن الأستاذ الكبير // سليم حاصبيا

اليكم طريقة أخري بالكود مع تغيير طفيف شكل الشيت

الكود بحدث Sheet2

يعمل تلقائيا بمجرد ادخال التاريخين

 

جلب بيانات بين تاريخين _ 1.rar

  • Like 1
رابط هذا التعليق
شارك

السلام عليكم

شكراً استاذ سليم  هل ممكن يكون الكود اسرع يوجد به بطئ شديد وهذا في عدم وجود بيانات كثيرة اروج اسراع الكود

 

شكراُ استاذ محمود كود سهل وبسيط ياريت يكون الكود في مفتاح  ويكون على اوفيس 2003

بارك الله فيكم

رابط هذا التعليق
شارك

السلام عليكم

 

كود سهل وخفيف

الملف تم تعديله وهو جاهز  لتعم الفائدة

 

لكن نريد من احد الاساتذة شرح الكود لكي نستطيع وضعة في اى ملف آخر مع حيث يمكن تغيير اماكن خلية  البحث بين التاريخين

 

 

 

Sub Work()
Sheet2.Range("B13:E5000").ClearContents
r = 13
For i = 13 To Sheet1.Range("E10000").End(xlUp).Row + 1
If Sheet2.Range("D8").Value = "" Then GoTo a
If Sheet2.Range("D8").Value <= Sheet1.Cells(i, "E") Then
a:
If Sheet2.Range("D9").Value = "" Then GoTo a1
If Sheet2.Range("D9").Value >= Sheet1.Cells(i, "E") Then
a1:
Sheet2.Cells(r, 2) = Sheet1.Cells(i, 2)
For j = 1 To 5
Sheet2.Cells(r, j) = Sheet1.Cells(i, j)
Next j
r = r + 1
End If
End If
Next i
End Sub

 

 

 

 

جلب بيانات بين تاريخين _ 2.rar

تم تعديل بواسطه محمد الخازمي
رابط هذا التعليق
شارك

أخى الكريم

مجهود رائع مشكور عليه

شرح الكود بإختصار

يبدأ بتحديد المدى الذى سينقل إليه البيانات ويقوم بمسحه من أى بيانات به

تحديد السطر رقم 13 وهو سطر بدء استدعاء البيانات إليه

حلقة تكرارية تبدأ من السطر 13 من الشيت المصدر بالعمود E حتى آخر صف تم تحديده ( 10000 ) عمود التاريخ

جملة شرطية فى حاله الخلية D8 بها بيانات اذهب إلى A لتدوير الحلقة التكرارية بين الشرطين و D9

والخاصيين بالتاريخ الموجود بالعمود E فى كلا الشيتين ( أى أن العمود E  فى الشيت 1 والشيت 2 بهم الشرط وهو التاريخ )

 

 

رابط هذا التعليق
شارك

اسف

اقصد العمود وليس السطر

 

يعني بدل ان يبدا جلب البيانات من بداية العمود b13 مثلاً  يكون جلب البيانات للعمود  s10 مثلاً

تم تعديل بواسطه محمد الخازمي
رابط هذا التعليق
شارك

أخى الكريم

شرح الكود سطر سطر لأنى لا أعرف مقصدك

-------------------------

Sheet2.Range("B13:E5000").ClearContents

هذا السطر يتحدث عن النطاق الذى سيتم ادخال البيانات أى جلب أى استعلام البيانات بالشيت 2 شيت البحث ، والنطاق المذكور هو النطاق

الذى سيتم مسح أى بيانات بداخله استعدادا للبيانات الجديدة

----------------------------

r = 13

هذا السطر يتحدث عن أن r  تساوى 13 أى أن الصف رقم 13 بشيت 2 بداية جلب البيانات له

------------------------

For i = 13 To Sheet1.Range("E10000").End(xlUp).Row + 1

هذا السطر بداية حلقة تكرارية بنقول فيه ان (( i  ))  تساوى 13 أى الصف رقم 13 بشيت 1 شيت المصدر 

لغاية المدى E10000 حتى آخر صف بهذا العمود بالنطاق المحدد 10000

-------------------------

If Sheet2.Range("D8").Value = "" Then GoTo a
If Sheet2.Range("D8").Value <= Sheet1.Cells(i, "E") Then

هذان السطرين يتحدثان عن الحلقة التكرارية المطلوبة بالشروط التى سنضعها 

فى حالة كون الخلية D8 بشيت 2 وهو شيت الاستعلام وليس المصدر اذهب الى الشيت 1 فى العمود E

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

-------------------

Sheet2.Cells(r, 2) = Sheet1.Cells(i, 2)

هذا السطر مهم وقد يكون هو الذى تسأل عنه

بنقول فيه 

شيت 2 ، السطر r وتم تعريفه سابقا أنه رقم 13 ، العمود الثاني وهو B

بيساوى 

الشيت 1 ، السطر i وتم تعريفه سابقا أنه رقم 13 ، العمود الثاني وهو B

 

 

رابط هذا التعليق
شارك

السلام عليكم  استاذ محمود المقصود من كلامي هو تغيير الاعمد التي ستم جلب البيانات اليها في صفحة الاستدعاء 

 

وهذه صورة تقريبية للتغيير المكان

الصورة رقم 1 هي الموجودة في الكود  الاستدعاء يبداء من العمود a الي العمود d

 

 

الصورة رقم 2 لو حبيت اغير مكان الاستدعاء ليبدا من العمود s الي العمود v

 

فا اي سطر في الكود يتم تغيير ليكون الاستدعاء يبدا من العمود s

1.png

22.png

تم تعديل بواسطه محمد الخازمي
رابط هذا التعليق
شارك

أخى الكريم 

الكود راح يكون هكذا 

ولاحظ التغيير فيه

مع تغيير أماكن خلايا الشرط أصبحت ( T9 و U9 ) وتغيير النطاق بشيت الاستعلام

مرفق مثال توضيحي على الملف الخاص بكم

Sub Work()
Sheet2.Range("S13:V5000").ClearContents
r = 13
For i = 11 To Sheet1.Range("E10000").End(xlUp).Row + 1
If Sheet2.Range("T9").Value = "" Then GoTo a
If Sheet2.Range("T9").Value <= Sheet1.Cells(i, "E") Then
a:
If Sheet2.Range("U9").Value = "" Then GoTo a1
If Sheet2.Range("U9").Value >= Sheet1.Cells(i, "E") Then
a1:
Sheet2.Cells(r, 19) = Sheet1.Cells(i, 2)
Sheet2.Cells(r, 20) = Sheet1.Cells(i, 3)
Sheet2.Cells(r, 21) = Sheet1.Cells(i, 4)
Sheet2.Cells(r, 22) = Sheet1.Cells(i, 5)
r = r + 1
End If
End If
Next i
End Sub

 

جلب بيانات بين تاريخين_2.rar

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information