كيف يمكن عمل كود بديل لدالة Vlookup لإستيراد البيانات بتلك الملفات؟؟

[أحمد مرجان]

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

حاولت كثيرا فى حدود خبرتى المتواضعة جدا بالأكواد استيراد البيانات من ملف (1) لملف آخر (النتيجة) كحل بديل للدوال المتخصصة فى ذلك كدالة vlookup من خلال البحث فى مواضيع مشابهة ولكننى فشلت فى التنفيذ، أرجو المساعدة وشكرا...

VBA for Vlookup.rar

[أحمد مرجان]

للرفع

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

اخى احمد

هل تقصد هكذا

تقبل تحياتى

1.rar

[أحمد مرجان]

أولا مشكور أخى الكريم على الرد السريع 

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

كما أريد استيراد البيانات من ملف خارجى وهو مغلق لذلك أرفقت ملفين أكسل لهذا الغرض

فهل هناك حل لذلك أخى الكريم؟

وشكرا...

[أحمد مرجان]

هل من حل

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

الأخ الحبيب أحمد مرجان

نعتذر عن التأخير في تقديم المساعدة (وكل تأخيرة فيها عطلة للناس بس أكيد فيها خيرة بردو)

إليك الكود التالي (وعشان غرامة التأخير مرفق شرح لكل أسطر الكود عشان تقدر تعدل بما يناسبك إن شاء الله)

Sub ImportDataFromClosedWBUsingVLOOKUP()
'تعريف المتغيرات
    Dim WBK As Workbook
    Dim Rng As Range
    Dim LastRow As Long
'إيقاف تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
'إيقاف خاصية رسائل التنبيه
    Application.DisplayAlerts = False
    
'ليساوي المصنف المسمى 1 والموجود في نفس مسار المصنف الحالي [WBK] تعيين قيمة للمتغير
'يقوم هذا السطر أيضاً بفتح المصنف في المسار المذكور
        Set WBK = Workbooks.Open(ThisWorkbook.Path & "\1.xlsx")
'تعيين قيمة للنطاق المراد جلب البيانات منه من المصنف المسمى 1
        Set Rng = Range("A2:C" & Cells(Rows.Count, 1).End(xlUp).Row)
        
'[Sheet1] بدء التعامل مع المصنف الحالي في ورقة العمل
        With ThisWorkbook.Sheets("Sheet1")
'تحديد رقم صف آخر خلية بها بيانات في العمود الأول
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'وضع معادلة دالة البحث في العمود الثاني والحصول على النتيجة من العمود الثاني في المصنف 1
            With .Range("B2").Resize(LastRow - 1)
                .Formula = "=IFERROR(VLOOKUP(A2," & Rng.Address(, , , True) & ",2,False),"""")"
                .Value = .Value
            End With
'وضع معادلة دالة البحث في العمود الثالث والحصول على النتيجة من العمود الثالث في المصنف 1
            With .Range("C2").Resize(LastRow - 1)
                .Formula = "=IFERROR(VLOOKUP(A2," & Rng.Address(, , , True) & ",3,False),"""")"
                .Value = .Value
            End With
        End With
'إغلاق المصنف المأخوذ منه البيانات بدون حفظ
        WBK.Close SaveChanges:=False

'إعادة تفعيل خاصية رسائل التنبيه
    Application.DisplayAlerts = True
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

وبكدا نكون دفعنا غرامة التأخير والحمد لله

تقبل تحياتي

Import Data From Closed WB Using VLOOKUP YasserKhalil.rar

[أحمد مرجان]

حبيبي يا أستاذ ياسر

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

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

أخي الحبيب أحمد مرجان (والإكسيل هيبقا بالمجان ..بس على أوفيسنا)

الحمد لله أن تم المطلوب على خير ، ومشكور على أفضل إجابة والالتزام بالتوجيهات.

وإن شاء الله تكون استفدت (مش من حل المشكلة لكن تكون استفدت من الكود بحيث تقدر تعدل عليه بما يتناسب معك)

تقبل تحياتي

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

اخى ياسر

كود جميل

وفرت علينا المجهود

تقبل تحياتى

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

مشكور أخي وأستاذي إبراهيم على مرورك العطر وعلى مجاملتك الرقيقة

بارك الله فيك

تقبل تحياتي

[yamanyy]

لو الداتا بتعتى اكتر من 200000 هل الكود ده هاسعفنى فى الوقت ولا لا ؟