استبدال معادلة Vlookup بكود لجلب بيانات من ملف اكسل آخر

[ابو تميم]

حية طيبة

لدي ملف اكسل يحتوي على معادلات Vlookup تعمل على جلب بيانات من ملف اكسل آخر والمعادلة المستخدمة.هي

 =IFERROR(VLOOKUP(C1;'D:\MyExcel.xlsb'!Device;6;FALSE);"")

حيث MyExcel هو الملف الرئيسي الذي يحتوي على البيانات

Device هو نطاق البيانات في الملف MyExcel

و C1 هي الخلية معيار البحث

وأرغب بتحويل هذه المعادلة إلى كود في VBA بحيث أتخلص من المعادلات في الملف

جزاكم الله خيرا

[رجب جاويش]

أخى الفاضل / ابو تميم

يفضل ارفاق ملف

حتى يمكن عمل المطلوب

[ابو تميم]

شكرا استاذ رجب

تم تطبيق مثال على المطلوب

جزاكم الله خيرا

Vlookup_VBA.rar

[رجب جاويش]

تفضل أخى

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [C1]) Is Nothing Then

Application.ScreenUpdating = False

    On Error Resume Next

    x = ActiveWorkbook.Path & "\" & "MyExcel" & ".xlsm"

    Workbooks.Open Filename:=x

    Set Rng = Sheets("æÑÞÉ1").Range("A2:A24")

    For Each cl In Rng

    If [C1] = cl Then

    Cells(4, 3) = cl.Offset(0, 1)

    Cells(5, 3) = cl.Offset(0, 2): Exit For

    End If

    Next

    Workbooks(x).Activate

    Activewindow.Close

    End If

Application.ScreenUpdating = True

Set Rng = Nothing

End Sub

Vlookup_VBA.rar

[ابو تميم]

شكرا جزيلا أستاذ رجب

هل يمكن أن يقوم الكود بجلب البيانات بدون الحاجة إلى فتح الملف المصدر مثل دالة vlookup

جزاك الله خيرا

[رجب جاويش]

تفضل أخى

Private Function GetData(Path, File, Sheet, Address)

	  Dim Data$

	  Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _

		    Range(Address).Range("A1").Address(, , xlR1C1)

	  GetData = ExecuteExcel4Macro(Data)

End Function

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [C1]) Is Nothing Then

Dim FilePath$, Address$

'***************************************

Const FileName$ = "MyExcel.xlsm"

Const SheetName$ = "ورقة1"

FilePath = ActiveWorkbook.Path & "\"

'***************************************

DoEvents

Application.ScreenUpdating = False

If Dir(FilePath & FileName) = Empty Then

    MsgBox "الملف " & FileName & " غير موجود", , "ملف غير موجود"

Exit Sub

End If

x = Cells(1, 3).Value + 1

Address = Cells(x, 2).Address

Cells(4, 3) = GetData(FilePath, FileName, SheetName, Address)

Address = Cells(x, 3).Address

Cells(5, 3) = GetData(FilePath, FileName, SheetName, Address)

End If

End Sub

Vlookup_VBA.rar

[ابو تميم]

ما شاء الله تبارك الله

الله يحميك أستاذ رجب ويزيدك علما فوق علم

هل أطمع في كرم أخلاقك أكثر وأطلب منك تطبيق نفس النظرية ولكن بالعكس بحيث أجلب البيانات من الملف السابق إلى الملف MyExcel كما في المثال المرفق

ولكن هنا الاعتماد على رقم الملف

أي أنا طرحت مثال عند الرقم 3 يتم جلب البيانات من الملف رقم 3 إلى MyExcel كما في المثال

جزاك الله خيرا وبارك الله فيك

Vlookup_VBA_AA2.rar

[رجب جاويش]

هل تقصد هكذا

Vlookup_VBA_AA2.rar

[ابو تميم]

تماما هذا هو المقصود والمطلوب

ولكن كيف نستطيع تطبيق هذا الكود على جميع الجدول في الملف MyExcel وفي حال أضفنا بيانات جديدة على الجدول كيف نطبق الكود عليها دون وضع كود لكل رقم من الجدول

جزاك الله خيرا وبارك الله فيك

[رجب جاويش]

أخى الفاضل

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

ثم أرفق الملف

[ابو تميم]

أستاذ رجب

جزاك الله خيرا

بالنسبة إلى الملف رقم 3 السابق هو نفس الملف الذي ستكون باقي الملفات ذات الاسماء الأرقام وستكون البيانات المراد نقلها في نفس المكان ونفس الخلايا

ولكن الاختلاف سيكون في الجدول في الملف MyExcel والتغيير سيكون في الجدول للأسفل أي البيانات التي ستتم إضافتها ستكون في نفس الجدول ونفس الأعمدة ولكن للأسفل وبترتيب الأرقام في العمود الاول A

أي أنه الآن الجدول يحتوي على 23 رقم فقط أي 23 ملف بنفس الملف رقم 3

والتغيير سيكون بإضافة رقم 24 ورقم 25 وهكذا كلما دعت الحاجة

جزاك الله خيرا

[رجب جاويش]

عذرا أخى الفاضل

أرجو مزيد من التوضيح

أو ارفاق ملف

[أحمد مرجان]

مجهود رائع ومشكور أستاذ رجب بس أنا عندى سؤال بعد إذنك أنا ملاحظ ان حجم الملف بالكود حوالى 17 ك.ب بينما لاحظت الملف بمعادلة Vlookup حوالى 11 ك.ب هل ده ممكن يؤثر فى سرعة الملف؟ وخصوصا لو تم تعميم التجربة على الملفات الكبيرة ذات المعادلات المعقدة؟

تم تعديل أبريل 17, 2015 بواسطه أحمد مرجان

[شعبان فليفل]

السلام عليكم 

طلب صغير  طمعاً في كرم حضراتكم

واجهتني مشكلة 

V lookup بسبب دالة الـ 

الموجودة في الخلايا 

a2, c2, d2, k2, l2, m2, k4, l4, m4

أحتاج إلي تحويلها إلي كود 

Shaaban.rar