logo

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



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




موضوع مغلق


  • تمت الإجابة
28-02-2021 09:54 مساءً
السلام عليكم أحبتي في المنتدى
من خلال الملف المرفق أريد استنتاج حركة التلاميذ من شيت data و نقلها إلى شيت حركة التلاميذ من خلال شهر معين ( القائمة المنسدلة في الخلية G6 شيت حركة التلاميذ)
نقل التلاميذ المعنيين للحركة الموجودة في العمودين لT و U وفقا للشهر الموجود في العمودين R و S
توضع ملاحظات في شيت حركة التلاميذ كالتالي :
خانة الدخول معبأة : دخول جديد
خانة الخروج معبأة : شطب
خانة الدخول و الخروجد معبأة : تغيير الصفة
مع تحياتي لكم
 
  النتائج المتوقعة.png   تحميل png النتائج المتوقعة.png مرات التحميل :(2)
الحجم :(92.657) KB
 
  تقرير.xlsm   تحميل xlsm مرات التحميل :(7)
الحجم :(75.401) KB


أثارت هذه المشاركة إعجاب: noureddine70،



look/images/icons/i1.gif ترحيل بيانات معينة
  01-03-2021 01:35 صباحاً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 226
الجنس :
الدعوات : 4
قوة السمعة : 2147
الاعجاب : 19
السلام عليكم ورحمة الله
استخدم هذا الكود
CODE
Sub TrnsfrData()
Dim Dta As Worksheet, ws As Worksheet
Dim Arr As Variant, Temp As Variant
Dim Rng As Range, i As Long, j As Long, p As Long
Dim StrDate As String, C As Range
Const NewInput As String = "دخول جديد"
Const Remov As String = "شطب"
Const ChngCas As String = "تغيير الصفة"

Set Dta = Sheets("data")
Set ws = Sheets("حركة التلاميذ")
T = Timer
Application.ScreenUpdating = False
ws.Range("A11:K30").ClearContents
Set Rng = Dta.Range("A7:U26")
StrDate = ws.Range("G6")
Arr = Rng.Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 18) = StrDate Or Arr(i, 19) = StrDate Then
p = p + 1
For j = 1 To 10
Temp(p, j) = Arr(i, Choose(j, 1, 2, 3, 6, 7, 8, 9, 14, 20, 21))
Temp(p, 1) = p
Next
End If
Next
If p > 0 Then ws.Range("A11").Resize(p, UBound(Temp, 2)).Value = Temp
For Each C In ws.Range("I11:I30")
If Not IsEmpty(C) And Not IsEmpty(C.Offset(0, 1)) Then
C.Offset(0, 2) = ChngCas
ElseIf Not IsEmpty(C) Then
C.Offset(0, 2) = NewInput
ElseIf Not IsEmpty(C.Offset(0, 1)) Then
C.Offset(0, 2) = Remov
Else
C.Offset(0, 2) = Empty

End If
Next
Application.ScreenUpdating = True
MsgBox Round(Timer - T, 2)
End Sub

أثارت هذه المشاركة إعجاب: YasserKhalil، ayoub2007، حسين مامون، خالد الشاعر، noureddine70،



look/images/icons/i1.gif ترحيل بيانات معينة
  01-03-2021 09:08 صباحاً   [2]
معلومات الكاتب ▼
تاريخ الإنضمام : 24-11-2017
رقم العضوية : 1867
المشاركات : 160
الجنس :
تاريخ الميلاد : 23-12-1970
قوة السمعة : 111
الاعجاب : 1
تمام .ألف شكر أستاذ إبراهيم الحداد مع تحياتي

أثارت هذه المشاركة إعجاب: YasserKhalil، noureddine70،





المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
طلب مساعدة في ترحيل غيابات التلاميذ ayoub2007
1 72 ayoub2007
طلب تعديل في ترحيل بيانات بشروط خاصة في الترحيل بكار للأبد
1 54 بكار للأبد
محتاج كودترحيل saad mohamed
0 119 saad mohamed
تموذج ترحيل وبحث وتعديل على البيانات مالك ماريه
147 12416 sharawee707
ترحيل بيانات من خلايا مختلفه من ملفات الى ملف واحد مع كتابة الملاحظات التى تخص ترحيل البيانات Lotfy
7 253 YasserKhalil

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









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

الساعة الآن 06:07 AM