أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
كريم نظيم مجدى يونس-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة بحاجة الى كود ترحيل اكسيل اسئله واجابات


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





مساعدة في كود ترحيل

السلام عليكم السؤال الأول : في شيت نموذج إدخال البيانات أريد بعد إضافة أو حذف تلميذ ترحيل التلاميذ من شيت data ( ترحي ..



29-09-2020 04:12 مساء
ayoub2007
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-11-2017
رقم العضوية : 1867
المشاركات : 157
الجنس : ذكر
تاريخ الميلاد : 23-12-1970
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 106
 offline 

السلام عليكم 



السؤال الأول :



في شيت نموذج إدخال البيانات أريد بعد إضافة أو حذف تلميذ ترحيل التلاميذ من شيت data ( ترحيل العمود b -الاسم و اللقب- و العمود I -القسم المختصر )إلى شيت data2بحيث يخصص لكل قسم 50 صفا  مثلا : القسم 3ت ر/هم من 03إلى 53 القسم 3ت ر/هك من 53 إلى 103 و هكذا.......



السؤال الثاني :



في شيت Liste اريد إضافة زر لجلب قائمة التلاميذ من شيت data الخاصة بقسم معين يحدد من الخلية I2مع حساب عدد الذكور و الاناث 



و شكرا لكم .


 
 
  mon travail.xlsm   تحميل xlsm مرات التحميل :(2)
الحجم :(2148.751) KB


29-09-2020 05:37 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif مساعدة في كود ترحيل
السلام عليكم
المطلوب غير واضح على الإطلاق .. يرجى التركيز في الموضوع على طلب واحد فقط مع توضيح المسألة بشيء من التفصيل.

29-09-2020 08:34 مساء
مشاهدة مشاركة منفردة [2]
ayoub2007
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-11-2017
رقم العضوية : 1867
المشاركات : 157
الجنس : ذكر
تاريخ الميلاد : 23-12-1970
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 106
 offline 
look/images/icons/i1.gif مساعدة في كود ترحيل
شكرا أستاذ ياسر 
هذه بعض الصور للمطلوب و النتائج ربما توضح أكثر معذرة مرة أخرى
 
  الترحيل.png   تحميل png الترحيل.png مرات التحميل :(0)
الحجم :(120.133) KB
  التصفية و الفرز.png   تحميل png التصفية و الفرز.png مرات التحميل :(0)
الحجم :(295.524) KB
  النتيجة.png   تحميل png النتيجة.png مرات التحميل :(0)
الحجم :(76.453) KB
 


30-09-2020 07:37 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif مساعدة في كود ترحيل
الرجاء من الأخوة الأعضاء التفاعل مع الموضوعات ومحاولة تقديم المساعدة بقدر استطاعتهم ، فالأفكار تتكامل بالمناقشة.

30-09-2020 02:36 مساء
مشاهدة مشاركة منفردة [4]
ayoub2007
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-11-2017
رقم العضوية : 1867
المشاركات : 157
الجنس : ذكر
تاريخ الميلاد : 23-12-1970
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 106
 offline 
look/images/icons/i1.gif مساعدة في كود ترحيل
السلام عليكم 
هذا كود للاستاذ سليم كنت أستعمله و شغال مية مية لكن مؤخرا بدأت تظهر لي رسالة (الصورة المرفقة) و لا يتم المطلوب

Option Explicit
Sub give_data()
If ActiveSheet.Name <> "data" Then Exit Sub
Dim i%: i = 3
Dim Laste_Row%, k%, m%
Dim arr, arr_num()
Dim rg As Object
arr_num = Array(3, 53, 103, 153, 203, 253, 303, 353, 403, 453)
Laste_Row = Sheets("data").Cells(Rows.Count, 1).End(3).Row
Sheets("data2").Range("a3").Resize(1000, 3).ClearContents
 
Set rg = CreateObject("system.collections.arraylist")
With rg
 Do Until i > Laste_Row
  If Not .contains(UCase(Range("i" & i).Value)) Then .Add UCase(Range("i" & i).Value)
 i = i + 1
 Loop
 
  arr = .toarray
 End With
 For i = LBound(arr) To UBound(arr)
   m = arr_num(i)
    For k = 3 To Laste_Row%
      If Sheets("data").Cells(k, "I") = arr(i) Then
         With Sheets("data2").Cells(m, 1)
           .Value = Sheets("data").Cells(k, "A")
           .Offset(, 1) = Sheets("data").Cells(k, "B")
           .Offset(, 2) = Sheets("data").Cells(k, "I")
            m = m + 1
         End With
       End If
     Next
  Next
  Set rg = Nothing: Erase arr_num: Erase arr
End Sub

 
 
  Capture96.png   تحميل png Capture96.png مرات التحميل :(4)
الحجم :(139.588) KB
 





الكلمات الدلالية
مساعدة ، ترحيل ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 12:40 مساء