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

محتاج تصحيح كود قوائم الفصول


2saad
إذهب إلى أفضل إجابة Solved by ابراهيم الحداد,

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

السلام الله عليكم ورحمته وبركاته ..اخواني أعضاء المنتدي الكرام

محتاج تعديل علي كود الملف المرفق بحيث ينقل البيانات من شيت (بيانات ) الي شيت فصول بطريقة مطاطية بحيث تقفل القائمة عند آخر سطر بيانات

وشكرا لكم جميعا ..أنا آسف الملف مرة أخري بالكود المطلوب تصحيحه ..والف شكر لكم جميعا

انتبه من فضلك .. مشاركة مكررة فقد تــــم بالفعل حذف المشاركة الأخرى

قوائم.xlsm

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

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

اخى الكريم جرب هذا الكود ..لو لك طلبات غير و اضحة فى مشاركتك الاولى يرجى توضيحها

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

بحيث نتمكن من اختبار الكود جيدا ..ارجو الاجابة بوضوح بعد التجربة ..اليك الكود

Sub AdClass()
Const K1 = "ذكر": Const K2 = ""
Dim Sh As Worksheet, ws As Worksheet
Dim Arr As Variant, Tmp As Variant
Dim LR As Long, p As Long, i As Long, ii As Long, j As Long
Dim Fsl As String, C As Range
Application.ScreenUpdating = False
Set Sh = Sheets("بيانات"): Set ws = Sheets("فصول")
ws.Range("D10:I49") = "": ws.Range("K10:P49") = ""
LR = Sh.Range("E" & Rows.Count).End(3).Row
Fsl = ws.Range("O7").Value
For Each C In Sh.Range("J10:J" & LR)
If C.Value = Fsl Then
p = p + 1
If p <= 40 Then
On Error Resume Next
ws.Range("D" & p + 9).Resize(, 6).Value = Sh.Range("D" & C.Row).Resize(, 6).Value
Else
ws.Range("K" & p - 31).Resize(, 6).Value = Sh.Range("D" & C.Row + 40).Resize(, 6).Value
End If
End If
Next
Application.ScreenUpdating =true
End Sub

 

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

اتاذنا الفاضل / الأستاذ إبراهيم  ..بارك الله فيك وأكثر الله من أمثالك

الكود شغال تمام وظبط البيانات ونوعتها ..بس ناقص حاجة واحدة ويكتمل الكود كما هو مطلوب

وهو عايز الأولاد لوحدهم في عمود ( E) وعايز البنات وحدهم في عمود (L )..يبقي كده بارك الله فيك ..أنا عارف إني بتعبك معاي كتير ..أسف علي الخطأ / أستاذنا

قوائم.xlsm

 

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

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

تم الغاء شرط العدد 40 سواء بالنسبة للذكور او الاناث 

و اصبح الشرط هو انتماء التلميذ للفصل و النوع فقط   ..هذا و الله ولى التوفيق

Sub AdClass()
Const K1 = "ذكر": Const K2 = "أنثى"
Dim Sh As Worksheet, ws As Worksheet
Dim LR As Long, p As Long, q As Long
Dim Fsl As String, C As Range
Application.ScreenUpdating = False
Set Sh = Sheets("بيانات"): Set ws = Sheets("فصول")
ws.Range("D10:I49") = "": ws.Range("K10:P49") = ""
LR = Sh.Range("E" & Rows.Count).End(3).Row
Fsl = ws.Range("O7").Value
For Each C In Sh.Range("J10:J" & LR)
If C.Value = Fsl And C.Offset(0, -3) = K1 Then
p = p + 1
ws.Range("D" & p + 9).Resize(, 6).Value = Sh.Range("D" & C.Row).Resize(, 6).Value
ElseIf C.Value = Fsl And C.Offset(0, -3) = K2 Then
q = q + 1
ws.Range("K" & q + 9).Resize(, 6).Value = Sh.Range("D" & C.Row).Resize(, 6).Value
End If
Next
Application.ScreenUpdating = True
End Sub

 

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

شكرا جزيلا أستاذنا الكبير ..هل هناك كود يطبع كل الفصول دفعة واحدة متتالية ؟معلش انا بتعبك معاي وأتمني أن يتسع صدرك لكي نستفيد من خبرات حضرتك .

معلش يا أستاذ إبراهيم ..فيه ملحوظة كمان في الكود

مش عايزه يمسح اي بيانات بعد الصف 43 علشان هكتب بيانات تحت ( وكيل شئون الطلبة - مدير المدرسة ) وهكذا ..انا آسف بتعبك معاي

قوائم.xlsm

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

  • أفضل إجابة

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

اخى الكريم الكود يقوم بمسح البيانات حتى الصف رقم 49  ..سيتم رفع الملف بعد التعديلات لصعوبة تطبيقها بنفسك

قوائم.xlsm

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

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

بالنسبة للزر الاول هو لعرض بيانات فصل محدد من القائمة المنسدلة دون طباعة 

اما الزر الثانى فهو مخصص لعرض  الفصول بداية من الفصل الاول حتى الاخير و طباعته مباشرة ..الكود التالى لطباعة ورقة محددة بعد عرضها عن طريق الزر الاول

Sub PrnData()  
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False
End Sub

 

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

السلام عليكم ورحمة الله ..الارقام فى هذا السطر بالكود اجعلها هكذا

Fsl = WorksheetFunction.Index(ws.Range("S8:T" & xx + 7), i, 1)

يعنى 7 يتحول الى 8 و 6 يتحول الى 7

  • 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