اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر

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

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

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

الكود بحدث 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 بهم الشرط وهو التاريخ )

 

 

قام بنشر

أخى الكريم

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

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

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