ممكن عمل كود يحل محل الدالة vlookup ؟

[mselmy]

بسم الله الرحمن الرحيم

قمت بعمل ملف باسم (استاذ مساعد) مكون من ثلاث ورقات عمل

الاولى عباره عن قاعدة البيانات , وميزان المراجعة

الثانية : شاشة الادخال , وكشوف الحساب

الثالثة : هى ورقة العمليات وهى مخفيه

فى الورقة الثانية وهى شاشة الادخال اقوم بادخال كود المورد وبالتالى يظهر اسم المورد فى الخلية الجاورة (vlookup) هل من الممكن عمل كود يحل محل هذه الداله

وانشاء الله سوف ارفق ملف فيه هذا الملف لعل ان يكون فيه فائده لبعض الزملاء من المحاسبين , وانا اسف على التطويل مع تحياتى محاسب / mselmy

[محمد حجازي]

السلام عليكم ...

إذا كانت لك خبرة في الفيجوال فإنه لا ينقصك سوى معرفة التعليمة WorksheetFunction ، لا حظ الكود التالي:

Sub Function_Vlookup()
Sheets("Sheet1").Range("D1").Value = Application.WorksheetFunction.VLookup(Sheets("Sheet1").Range("A1").Value, Sheets("Sheet1").Range("B1:C10").Value, 2, False)
End Sub

الكود السابق يقوم بالبحث عن القيمة الموجودة في الخلية A1 في العامود B ويرجع القيمة المقابلة لها في العامود C ويلصق القيمة الناتجة عن البحث في الخلية D1.

بالتوفيق

تم تعديل مارس 10, 2005 بواسطه محمد حجازي

[mselmy]

انا ممتن جدا لاهتمامك هذا

ولكن هذا الكود يعمل فقط على خليه واحدة وهى A1 , D1 ولكن انا اريد كود يعمل على العامود كلة او حيز منه انا احدده هذا اولا

ثانيا : اريد الكود يعمل بمجرد ان ادخل رقم ( كود المورد ) واضغط انتر للانتقال للخليه التاليه يقوم الكود بالعمل على سبيل المثال

كود المورد (A) اسم المورد العمود (B)

1 محمد

2 على

3 محمود

ثانيا الادخال عمود ( C)

عندما اضع رقم المورد فى العمود سى واضغط انتر

يظهر مباشرتا اسم المورد فى العامود (D ) الخليه المقابلة

معلش ممكن يكون اسلوبى غير جيد فى شرح مطلبى لكن اعتقد انك بخبرتك انشاء الله هتعرف قصدى , واكرر شكرى الجزيل لحضرتك

اخيك محاسب / محمد سلمى

[محمد حجازي]

السلام عليكم ...

مازال الشرح غير واضح :

لننظر إلى الكود التالي:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row >= 2 And Target.Row <= 20 Then
  Me.Cells(Target.Row, 3).Value = Application.WorksheetFunction.VLookup(Sheets("Sheet2").Range("A1").Value, Sheets("Sheet2").Range("B1:C10").Value, 2, False)
End If
End Sub

الكود السابق يتم لصقه في الورقة المطلوبة ، وهو يعمل بمجرد تفجير حدث تعديل خلية موجودة في نفس الورقة. - يجب قبل كل شيء تحديد مجال عمل الكود ، ففي الكود السابق حددنا المجال A2:A20 على أنه المجال الذي يكون فيه الكود فعال ، لننظر كيف ترجمنا المجال السابق:

If Target.Column = 1 And Target.Row >= 2 And Target.Row <= 20 Then

المتغير Target يستخدم للإشارة إلى الخلية التي تم تعديلها. الآن من الشرط السابق : إذا كانت الخلية المعدلة موجودة في العامود الأول وأن سطرها ينتمي للمجال المغلق [2,20] فإنه سيتم الانتقال للعبارة التالية:

  Me.Cells(Target.Row, 3).Value = Application.WorksheetFunction.VLookup(Sheets("Sheet2").Range("A1").Value, Sheets("Sheet2").Range("B1:C10").Value, 2, False)

وإلا فلا. - العبارة السابقة (الثانية) تعمل على البحث عن القيمة الموجودة في الخلية A1 (في الورقة Sheet2) وذلك ضمن العامود الأول من المجال B1:C10 (العامود B في الورقة Sheet2) وترجع القيمة المقابلة لها في العامود C (في الورقة Sheet2) . القيمة الناتجة عن عملية البحث السابق يتم لصقها في الخلية المقابلة للخلية المعدلة في العامود C:

Me.Cells(Target.Row, 3).Value

لاحظ من العبارة البرمجية السابقة أننا استخدمنا Me للدلالة على الهدف الحالي (الورقة الموجود فيها الكود) ، وأننا استخدمنا التعليمة Cells للإشارة إلى الخلية المقابلة للخلية المعدلة في العامود الثالث C. مما سبق نستنتج أنه يمكننا تعديل الكود السابق ليتناسب مع احتياجاتنا ، لا حظ الكود التالي:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row >= 2 And Target.Row <= 20 Then
  Me.Cells(Target.Row, 3).Value = Application.WorksheetFunction.VLookup(Sheets("Sheet2").Cells(Target.Row, 1).Value, Sheets("Sheet2").Range("B1:C10").Value, 2, False)
End If
End Sub

وأخيراً ، يمكن القول بأن هذا هو طلبك :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Target.Row >= 2 And Target.Row <= 20 Then
  Me.Cells(Target.Row, 4).Value = Application.WorksheetFunction.VLookup(Target.Value, Me.Range("A2:B20").Value, 2, False)
End If
End Sub

وأظن أنك ستعرف بالضبط ما يحصل (بعد الشرح السابق) (y)

بالتوفيق

[mselmy]

عزيزى / محمد حجازى

لم استطع تطبيق الكود على ملف اكسل ودائما يظهر معى خطاء

فمن فضلك ممكن ممكن تعمل تجربة على ملف اكسل وترسله

معلش انا ازعجتك لكنى طمعان فى كرمك

اخيك محمد سلمى

[محمد حجازي]

السلام عليكم ...

الأخطاء قد تنتج عن عدم وجود ناتج للدالة VLOOKUP (يترجم للخطأ البرمجي 1004) ، وبذلك يمكنك اعتراض هذه الأخطاء و التعامل معه باستخدام الجملة On Error ، وهنا:

- يمكنك إظهار رسالة تخبرك بعدم وجود نواتج :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo NoNumber
 If Target.Column = 3 And Target.Row >= 2 And Target.Row <= 20 Then
   Me.Cells(Target.Row, 4).Value = Application.WorksheetFunction.VLookup(Target.Value, Me.Range("A2:B20").Value, 2, False)
 End If
 Exit Sub

NoNumber:
 If Err = 1004 Then
   MsgBox "الرقم المدخل غير موجود"
 Else
   MsgBox Err.Description
 End If

End Sub

- أو الاكتفاء بعدم إرجاع شيئ عندما لا يكون للدالة VLOOKUP أي نواتج:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo NoNumber
 If Target.Column = 3 And Target.Row >= 2 And Target.Row <= 20 Then
   Me.Cells(Target.Row, 4).Value = Application.WorksheetFunction.VLookup(Target.Value, Me.Range("A2:B20").Value, 2, False)
 End If
 Exit Sub

NoNumber:
 If Err <> 1004 Then
   MsgBox Err.Description
 End If

End Sub

مرفق مثال للطريقة الأولى:

VLOOKUP.zip

[tag4m]

السلام عليكم0000

استاذنا العزيز محمد حجازى

هل ممكن تعديل الكود بحيث ان جدول المعلومات يكون فى صفحة 1( العمود A , B)

وتطبيق الكود يكون فى صفحة 2 ( العمود A , B) ( بحيث بمجرد ادخال الرقم فى صفحة2 فى اى خلية بالعمود A يظهر البيان فى العمود b)

ايضا بخصوص ظهور الرسالة بان الرقم غير موجود

يبقى الرقم الغير موجود ظاهر ولا يتم حذفه

فهل ممكن حذف الرقم الغير موجود تلقائيا( بعد ظهور رسالة انه غير موجود)

فى انتظار ردك ياأستاذنا

[محمد حجازي]

السلام عليكم ...

ضع الكود التالي في الورقة المطلوب تطبيق الكود عليها (الورقة التي تريد نقل بيانات الورقة الأولى إليها):

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo NoNumber
 If Target.Column = 1 And Target.Row >= 2 And Target.Row <= 20 Then
   If Target.Value = "" Then Exit Sub
   Me.Cells(Target.Row, 2).Value = Application.WorksheetFunction.VLookup(Target.Value, Sheets(1).Range("A2:B20").Value, 2, False)
 End If
 Exit Sub

NoNumber:
 If Err = 1004 Then
   MsgBox "الرقم المدخل غير موجود"
   Target.ClearContents
 End If

End Sub

بالتوفيق

[tag4m]

شكرا لك، وجزاك الله كل خير يأستاذنا

تم تعديل مارس 25, 2005 بواسطه tag4m