استدعاء أو جلب بيانات من ورقة لورقة أخرى بأرقام ورموز اختصار محددة

[ماجد بن محمد]

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

 

لدي ملف أكسل مكون من ثلاث ورقات

 

الورقة الأولى ( ورقة العمل ) وهي المراد العمل عليها والمقصودة من الموضوع .

 

 

 

 

الورقة الثانية ( قاعدة بيانات " أسماء ومهن" ) تحتوي على أسم الموظف أو العامل ومهنته .

 

 

 

 

 

 

الورقة الثالثة ( قاعدة بيانات المسميات " مسمى الطلبات" ) تحتوي على مسمى الطلب المراد من قبل الموظف أو العامل.

 

 

 

 

 

المطلوب

 

1- جلب بيانات الموظف في ورقة العمل بالرقم الوظيفي من ورقة " قاعدة أسماء ومهن" وذلك بوضع الرقم في خلية "الأسم" وبعد ضغط زر الإدخال يظهر مكان الرقم أسم الموظف ويظهر معه أسم المهنة في خلية المهنة .

 

2- جلب بيانات الطلب في ورقة العمل نفسها من ورقة " قاعدة بيانات المسميات " بإدخال الرمز في خلية الطلب وتظهر في نفس خلية الطلب المقابلة لإسم الموظف ومهنته .

 

 

 

* تم إرفاق الملف وحذف رابط التحميل الخارجي

 

 

 

ملاحظة : ليس لدي أي معرفة بالأكواد أو البرمجة .

ملف 1.rar

تم تعديل أبريل 29, 2015 بواسطه 9863

[عبدالله فاروق ابو ريان]

اخي حاول ارفاق الملف هنا
انا حاولت احمل من الرابط مش بيحمل

[ياسر خليل أبو البراء]

الأخ 9758412354

أهلا بك في المنتدى ونورت بين إخوانك

 

يرجى تغيير اسمك للغة العربية

كما يرجى - وأؤكد يرجى - الإطلاع على رابط التوجيهات لمعرفة القواعد المفترض السير عليها بالمنتدى

http://www.officena.net/ib/index.php?showtopic=60147

 

وعند طرح موضوع وإرفاق ملف ، قم بضغط الملف ورفعه على سرفر المنتدى ، وليس رابط خارجي

وللأخوة الكرام الذي سيقدمون المساعدة إليكم الملف المرفق في المشاركة الأولى

 

تقبل تحياتي

ملف1.rar

[ماجد بن محمد]

الأخ 9758412354

أهلا بك في المنتدى ونورت بين إخوانك

 

يرجى تغيير اسمك للغة العربية

كما يرجى - وأؤكد يرجى - الإطلاع على رابط التوجيهات لمعرفة القواعد المفترض السير عليها بالمنتدى

http://www.officena.net/ib/index.php?showtopic=60147

 

وعند طرح موضوع وإرفاق ملف ، قم بضغط الملف ورفعه على سرفر المنتدى ، وليس رابط خارجي

وللأخوة الكرام الذي سيقدمون المساعدة إليكم الملف المرفق في المشاركة الأولى

 

تقبل تحياتي

 

أخي المشرف

ياسر خليل أبو البراء

 

أشكرك على ترحيبك بي

 

بالنسبة للإسم وصلة الرسالة

 

 

أما بالنسبة لملف الأكسل حاولت مرار وتكرار برفع الملف بصيغته الأولى ولم أتنبه إلى كيفية الرفع كما ورد في ردكم بالأعلى ( قم بضغط الملف ورفعه على سرفر المنتدى ) ألا الآن وشكر لك .

تم تعديل أبريل 29, 2015 بواسطه 9863

[ياسر خليل أبو البراء]

أخي الفاضل إليك الملف التالي

تم عمل الطلب الأول بالمعادلات .. تم استخدام الدالة Vlookup بعد تسمية نطاق البيانات باسم Data

أما الطلب الثاني فتم الاستغناء تماما عن ورقة العمل المسماة "قاعدة مسميات" وعمل المطلوب بالأكواد ، ولن يتأثر العمود D إلا إذا كان العمود A يحتوي على بيان فيه وإلا سوف يتم مسح البيانات حسب الكود المرفق

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 1 And Target.Column = 4 Then
        Application.EnableEvents = False
            If IsEmpty(Target.Value) Or IsEmpty(Target.Offset(, -3)) Then
                Target.Value = ""
            ElseIf Target.Value = "تر" Then
                Target.Value = "تعديل راتب"
            ElseIf Target.Value = "تظ" Then
                Target.Value = "تظلم"
            ElseIf Target.Value = "اب" Then
                Target.Value = "إضافة بيانات"
            ElseIf Target.Value = "ن" Then
                Target.Value = "نقل"
            ElseIf Target.Value = "اخ" Then
                Target.Value = "إنهاء خدمة"
            ElseIf Target.Value = "ج" Then
                Target.Value = "أجازة"
            Else
                Target.Value = Target.Value
            End If
        Application.EnableEvents = True
    End If
End Sub

ملحوظة : لم يتم تغيير اسم الظهور .. يرجى مراجعة التوجيه الحادي عشر على هذا الرابط

http://www.officena.net/ib/index.php?showtopic=60147

 

 

VLOOKUP Formula & VBA.rar

[ماجد بن محمد]

أخي ياسر أشكر لك التجاوب السريع مع موضوعي وبورك فعلك ورفع الله قدرك وزادك الله علماً ومعرفة ونفع الله بك .

 

لكن هناك إشكال بسيط وهو بالنسبة للرقم الوظيفي , لا أريد أن يظهر في ورقة العمل

الذي أريد هو أن يطبع الرقم مكان الأسم ويظهر الأسم ويختفي الرقم ,هل من الممكن ذلك أم لا ؟

[ياسر خليل أبو البراء]

أخي الفاضل

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

وحتى إذا تم الأمر وكتبت رقم وجلب لك الاسم ..عند جلب الاسم سيقوم الكود بمحاولة التنفيذ مرة أخرى وربما يسبب أخطاء

صراحة لا أرى داعي لذلك ..ما المشكلة في العمود أن يحتوي على الرقم؟!

[ياسر خليل أبو البراء]

عموماً بعد عدة محاولات استطعت التغلب على الأمر

إليك الملف التالي عله يفي بالغرض

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 1 And Target.Column = 3 Then
        Application.EnableEvents = False
            If IsEmpty(Target.Value) Or IsEmpty(Target.Offset(, -2)) Then
                Target.Value = ""
            ElseIf Target.Value = "تر" Then
                Target.Value = "تعديل راتب"
            ElseIf Target.Value = "تظ" Then
                Target.Value = "تظلم"
            ElseIf Target.Value = "اب" Then
                Target.Value = "إضافة بيانات"
            ElseIf Target.Value = "ن" Then
                Target.Value = "نقل"
            ElseIf Target.Value = "اخ" Then
                Target.Value = "إنهاء خدمة"
            ElseIf Target.Value = "ج" Then
                Target.Value = "أجازة"
            Else
                Target.Value = Target.Value
            End If
        Application.EnableEvents = True
    End If
    
    If Target.Row > 1 And Target.Column = 1 Then
        Application.EnableEvents = False
            On Error Resume Next
            X = Target.Value
            Target.Value = Application.WorksheetFunction.VLookup(Target.Value, Sheet2.Range("A2:C11"), 2, 0)
            Target.Offset(, 1).Value = Application.WorksheetFunction.VLookup(X, Sheet2.Range("A2:C11"), 3, 0)
        Application.EnableEvents = True
    End If
End Sub

تقبل تحياتي كابتن ماجد

VLOOKUP Formula Change Target Value V2.rar

[ماجد بن محمد]

عموماً بعد عدة محاولات استطعت التغلب على الأمر

إليك الملف التالي عله يفي بالغرض

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 1 And Target.Column = 3 Then
        Application.EnableEvents = False
            If IsEmpty(Target.Value) Or IsEmpty(Target.Offset(, -2)) Then
                Target.Value = ""
            ElseIf Target.Value = "تر" Then
                Target.Value = "تعديل راتب"
            ElseIf Target.Value = "تظ" Then
                Target.Value = "تظلم"
            ElseIf Target.Value = "اب" Then
                Target.Value = "إضافة بيانات"
            ElseIf Target.Value = "ن" Then
                Target.Value = "نقل"
            ElseIf Target.Value = "اخ" Then
                Target.Value = "إنهاء خدمة"
            ElseIf Target.Value = "ج" Then
                Target.Value = "أجازة"
            Else
                Target.Value = Target.Value
            End If
        Application.EnableEvents = True
    End If
    
    If Target.Row > 1 And Target.Column = 1 Then
        Application.EnableEvents = False
            On Error Resume Next
            X = Target.Value
            Target.Value = Application.WorksheetFunction.VLookup(Target.Value, Sheet2.Range("A2:C11"), 2, 0)
            Target.Offset(, 1).Value = Application.WorksheetFunction.VLookup(X, Sheet2.Range("A2:C11"), 3, 0)
        Application.EnableEvents = True
    End If
End Sub

تقبل تحياتي كابتن ماجد

 

 

 

الشكر فيما فعلت قليل , رفع الله قدرك وجزاك الله خير ونفع بك .