عند كتابة اسم المدرسة يكتب الكود تلقائيا

[ابو عبدالرحمن البغدادي]

السلام عليكم

سؤالي هو : عندي شيت اسمه الاكواد فيه اسم المدرسة والكود 

وعندي شيت اسمه البيانات الرئيسية 

المطلوب هو عند ادراج اسم المدرسة في شيت البيانات الرئيسية خانة T يدرج الكود الخاص بالمدرسة في خانة U  تلقائي استناداً على ما موجود في شيت الاكواد مع الاشارة بان عدد المدارس والاقسام اكثر من 2000 مدرسة وروضة وقسم 

ان شاء الله طلبي متوفر - ووفق الله العاملين عليه ، ولدخول الى الملف :

اسم المستخدم : عبدالملك

الرقم السري : 112233

 

عند كتابة اسم المدرسة يدرج الكود تلقائي.rar

[إبراهيم ابوليله]

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

اخى ابو عبد الرحمن

فقط ضع هذا الكود فى حدث الورقه

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count <> 1 Then Exit Sub
' åÐÇ ÇáÓØÑ íãäÚ ÍÏæË ÇáÇÎØÇÁ Ýì ÍÇáÉ ãÓÍ ÇßËÑ ãä Îáíå ãÚ ÈÚÖåÇ
'--------------------------------------------------------------------
Dim Lr As Long
'--------------------------------------------------------------------
   Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     Application.EnableEvents = False
      Application.Calculation = xlCalculationManual

'--------------------------------------------------------------------

LrT = ورقه1.[T10000].End(xlUp).Row + 1
LRB = ورقه2.[B10000].End(xlUp).Row + 1

If Not Intersect(Target, ورقه.Range("T2:T" & LrT)) Is Nothing Then
For Each cll In ورقه2.Range("B2:B" & LRB)
If cll = Target Then
Target.Offset(0, 1) = cll.Offset(0, -1)
  Application.ScreenUpdating = True
   Application.DisplayAlerts = True
    Application.EnableEvents = True
     Application.Calculation = xlCalculationAutomatic

 Exit Sub
 End If
Next
End If
'--------------------------------------------------------------------
LrU = ورقه1.[U10000].End(xlUp).Row + 1
LRB = ورقه2.[B10000].End(xlUp).Row + 1

If Not Intersect(Target, ورقه1.Range("U2:U" & LrU)) Is Nothing Then
For Each cll In ورقه2.Range("B2:B" & LRB)
If cll.Offset(0, -1) = Target Then
Target.Offset(0, -1) = cll
  Application.ScreenUpdating = True
   Application.DisplayAlerts = True
    Application.EnableEvents = True
     Application.Calculation = xlCalculationAutomatic

 Exit Sub
 End If
Next
End If

End Sub

ملحوظه

يمكنك البحث اما بكود المدرسه

او باسم المدرسه

تقبل تحياتى

تم تعديل سبتمبر 16, 2015 بواسطه إبراهيم ابوليله

[محمد عبدالسلام]

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

اخى ابو عبد الرحمن ارجو الاطلاع على المرفق

بعد اذن الاستاذ الفاضل  إبراهيم ابوليله انا وضعت  الكود في الملف فقط

عند كتابة اسم المدرسة يدرج الكود تلقائي.zip

[ابو عبدالرحمن البغدادي]

السلام عليكم - الله يرضى عليك صارت عندي مشاكل من اضف الكود

حل الموضوع من يمك وراح انتبه على الذي ضفته 

اشكرك على المرور

انتظر جزيت خيرا

 

 

 

الاخ عبد السلام المحترم

لم احصل على النتيجة المطلوبة

جزيت خيرا - ممكن مراجعة الموضوع لأهميته

تم تعديل سبتمبر 16, 2015 بواسطه ابو عبدالرحمن البغدادي

[إبراهيم ابوليله]

اخى ابو عبدالرحمن

اليك الملف

 عند كتابة اسم المدرسة يدرج الكود تلقائي.rar

تقبل تحياتى

عند كتابة اسم المدرسة يدرج الكود تلقائي.rar

[ابو عبدالرحمن البغدادي]

السلام عليكم

تمام - احسنت - هو المطلوب - جزيت خيرا

[إبراهيم ابوليله]

اخى ابو عبد الرحمن

هل تقصد هكذا

تقبل تحياتى

عند كتابة اسم المدرسة يدرج الكود تلقائي.rar

[ابو عبدالرحمن البغدادي]

السلام عليكم

تمام 

احسنت

مشكور حفظكم الله