2saad قام بنشر فبراير 7 مشاركة قام بنشر فبراير 7 اخواني اعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته المطلوب بالملف المرفقبيانات التلاميذ.xlsm رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر فبراير 7 مشاركة قام بنشر فبراير 7 وضح المطلوب اخى الكريم رابط هذا التعليق شارك More sharing options...
2saad قام بنشر فبراير 7 الكاتب مشاركة قام بنشر فبراير 7 شكرا لرد حضرتك المطلوب موجود في المرفق المطلوب ضبط الكود بما يتلائم مع الملف بحيث عند الضغط علي زر ( جلب وترحيل ) يقوم بجلب الفصل من ( ملف نصف العام ) بناء علي الاختيار من القائمة المنسدلة في ( D1 و D3) ثم بعد رصد الدرجات والضغط علي الزر مرة أخري يقوم بترحيل الدرجات الي شيت ( ملف نصف العام ) أمام الفصل الذي اخترته وهكذااختار الفصل التالي بمعني عندما اختار الصف من القائمة المنسدلة D1 الموجودة بالورقة ( رصد الدرجات ) ثم اختار الفصل من القائمة المنسدلة D3 مثلا فصل (4 /1) ثم اضغط علي زر ( جلب وترحيل ) يقوم بنقل كل صف أمامه (4/ 1) من ورقة العمل (ملف نصف العام ) الي ورقة ( رصد درجات ) ثم أقوم برصد الدرجات للمواد الموجودة في ورقة العمل ( رصد درجات ) وبالضغط مرة أخري علي زر ( جلب وترحيل ) يقوم بترحيل الدرجات الي ورقة العمل ( ملف نصف العام ) لكل الصفوف التي أمامها فصل (4/ 1) رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر فبراير 7 مشاركة قام بنشر فبراير 7 للاسف اخى الملف لم يفتح حاول تشرح لى المطلوب فى نقاط نبتدى بالترحيل أو بالاستدعاء ونكمل البرنامج خطوة خطوة تمام 2 رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر فبراير 8 مشاركة قام بنشر فبراير 8 (معدل) وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا الحل هل يناسبك تم وضع كود لجلب البيانات وكود اخر لترحيلها للمكان المناسب على حسب ما فهمت من طلبك Sub Fetch_data() Dim clé As String, SH As String Set desWS = Sheets("رصد درجات") SH = desWS.Range("D1").Value Set f = ThisWorkbook.Sheets(SH) Application.ScreenUpdating = False Tbl = f.Range("C11:R" & f.[c65000].End(xlUp).Row).Value clé = desWS.Range("d3"): colClé = 2 b = arr(Tbl, clé, colClé) If Not IsEmpty(b) Then desWS.Range("C11:R" & Rows.Count).ClearContents desWS.[c11].Resize(UBound(b), UBound(b, 2)) = b Application.ScreenUpdating = True MsgBox "نتائج" & " " & f.Name Else MsgBox "لايوجد نتائج للشرط المعطى" End If End Sub Function arr(Tbl, clé, colClé, Optional Cpt) Dim r() Ncol = UBound(Tbl, 2) If IsMissing(Cpt) Then ReDim r(0 To Ncol - 1): For k = 0 To Ncol - 1: r(k) = k + 1: Next k Else r = Cpt End If Nr = UBound(r) n = 0 For i = LBound(Tbl) To UBound(Tbl) If clé = Tbl(i, colClé) Or clé = "" Then n = n + 1 Next i If n > 0 Then Dim b(): ReDim b(1 To n, 1 To UBound(r) + 1) n = 0 For i = LBound(Tbl) To UBound(Tbl) If clé = Tbl(i, colClé) Or clé = "" Then n = n + 1 For k = 0 To Nr: b(n, k + 1) = Tbl(i, r(k)): Next k End If Next i arr = b End If End Function بيانات التلاميذ 3.xlsm تم تعديل فبراير 8 بواسطه محمد هشام. Modify code 3 رابط هذا التعليق شارك More sharing options...
2saad قام بنشر فبراير 8 الكاتب مشاركة قام بنشر فبراير 8 شكرا جزيلا استاذنا الكبير ( أبو الحسن - محمد هشام ) وربنا يجزيكما كل خير علي تعبكما معنا وشكرا لكل أعضاء المنتدي الكرام 1 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.