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

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


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





المساعدة في كود

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


موضوع مغلق


subject icon تمت الإجابة المساعدة في كود
02-11-2021 06:10 مساء
saad mohamed
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 08-08-2019
رقم العضوية : 14161
المشاركات : 78
الجنس : ذكر
تاريخ الميلاد : 12-5-1973
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 65
 offline 

الاخوة االأفاضل الذين تعلمت منهم الكثير وربنا يجعله في ميزان حسناتهم



محتاج كود ترحيل   البيانات من شيت   data  الي شيت laskat



مستخدما القائمة المنسدلة للفصول في الخلية s8 كما هو موضح



اسم التلميذ



الصف



الفصل



تاريخ الميلاد



 



 



ولكم جزيل الشكر ووافر الاحترام


لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  رزان.xlsm   تحميل xlsm مرات التحميل :(7)
الحجم :(260.946) KB



أفضل إجابة مقدمة من ابراهيم الحداد وهي:
السلام عليكم ورحمة الله
تم الرد عليك فى المنتدى الاخر المنشور فيه موضوعك
و اليك الكود مرة اخرى
Sub CallSude()
Dim ws As Worksheet, Sh As Worksheet
Dim i As Long, p As Long, j As Long
Dim LR As Long, Fasl As String
Application.ScreenUpdating = False

Set ws = Sheets("laskat")
For x = 3 To 58 Step 5
ws.Cells(x, 3).ClearContents
ws.Cells(x + 1, 3).ClearContents
ws.Cells(x + 1, 6).ClearContents
ws.Cells(x + 2, 4).ClearContents

ws.Cells(x, 12).ClearContents
ws.Cells(x + 1, 12).ClearContents
ws.Cells(x + 1, 15).ClearContents
ws.Cells(x + 2, 13).ClearContents
Next

Fasl = ws.Range("S8").Text
Set Sh = Sheets("data")
LR = Sh.Range("C" & Rows.Count).End(3).Row

For i = 3 To LR
If Sh.Cells(i, 14) = Fasl Then
p = p + 1
j = 2
Do While j <= 57
If ws.Cells(j, 8) = p Then
ws.Cells(j + 1, 3) = Sh.Cells(i, 3)
ws.Cells(j + 2, 3) = Sh.Cells(i, 15)
ws.Cells(j + 2, 6) = Sh.Cells(i, 14)
ws.Cells(j + 3, 4) = Sh.Cells(i, 5)

ElseIf ws.Cells(j, 17) = p Then
ws.Cells(j + 1, 12) = Sh.Cells(i, 3)
ws.Cells(j + 2, 12) = Sh.Cells(i, 15)
ws.Cells(j + 2, 15) = Sh.Cells(i, 14)
ws.Cells(j + 3, 13) = Sh.Cells(i, 5)

End If
j = j + 5
Loop
End If
Next

Application.ScreenUpdating = True
End Sub

عرض الإجابة




03-11-2021 12:41 مساء
مشاهدة مشاركة منفردة [1]
ابراهيم الحداد
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 236
الجنس : ذكر
الدعوات : 4
يتابعهم : 0
يتابعونه : 33
قوة السمعة : 2329
عدد الإجابات: 30
 offline 
look/images/icons/i1.gif المساعدة في كود
السلام عليكم ورحمة الله
تم الرد عليك فى المنتدى الاخر المنشور فيه موضوعك
و اليك الكود مرة اخرى
Sub CallSude()
Dim ws As Worksheet, Sh As Worksheet
Dim i As Long, p As Long, j As Long
Dim LR As Long, Fasl As String
Application.ScreenUpdating = False

Set ws = Sheets("laskat")
For x = 3 To 58 Step 5
ws.Cells(x, 3).ClearContents
ws.Cells(x + 1, 3).ClearContents
ws.Cells(x + 1, 6).ClearContents
ws.Cells(x + 2, 4).ClearContents

ws.Cells(x, 12).ClearContents
ws.Cells(x + 1, 12).ClearContents
ws.Cells(x + 1, 15).ClearContents
ws.Cells(x + 2, 13).ClearContents
Next

Fasl = ws.Range("S8").Text
Set Sh = Sheets("data")
LR = Sh.Range("C" & Rows.Count).End(3).Row

For i = 3 To LR
If Sh.Cells(i, 14) = Fasl Then
p = p + 1
j = 2
Do While j <= 57
If ws.Cells(j, 8) = p Then
ws.Cells(j + 1, 3) = Sh.Cells(i, 3)
ws.Cells(j + 2, 3) = Sh.Cells(i, 15)
ws.Cells(j + 2, 6) = Sh.Cells(i, 14)
ws.Cells(j + 3, 4) = Sh.Cells(i, 5)

ElseIf ws.Cells(j, 17) = p Then
ws.Cells(j + 1, 12) = Sh.Cells(i, 3)
ws.Cells(j + 2, 12) = Sh.Cells(i, 15)
ws.Cells(j + 2, 15) = Sh.Cells(i, 14)
ws.Cells(j + 3, 13) = Sh.Cells(i, 5)

End If
j = j + 5
Loop
End If
Next

Application.ScreenUpdating = True
End Sub


03-11-2021 04:25 مساء
مشاهدة مشاركة منفردة [2]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 798
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 10
قوة السمعة : 4030
عدد الإجابات: 110
 offline 
look/images/icons/i1.gif المساعدة في كود
بارك الله فيك استاذ ابراهيم وجعله الله في ميزان حسناتك يوم القيامه



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


 










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

الساعة الآن 12:20 صباحا