دالة VLOOK2ALL New Look

[ابوالفتح]

شكرا جزبلا للاخ العبقرى الاستاذ عبدالله

[محمد عبد المجيد ( أبو حمزة )]

Sub ragab()

Application.ScreenUpdating = False

T = Range("D12").Value: TT = Range("E12").Value

R = ActiveWorkbook.Name

For i = 1 To 2

    On Error Resume Next

    x = ActiveWorkbook.Path & "\" & i & ".xls"

    Workbooks.Open Filename:=x, Password:=4444

        

        For Each cl In Workbooks(i).Sheets("ÊÝÕíáí ÇáÊÔÛíáÇÊ").Range("C4:C600")

        If cl = T And cl.Offset(0, 3) = TT Then

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("D15") = cl.Offset(0, -2)

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("D16") = cl.Offset(0, -1)

        End If

        Next

        

        For Each cl In Workbooks(i).Sheets("ÊÝÕíáí ÇáÊÔÛíáÇÊ").Range("P4:P600")

        If cl = T And cl.Offset(0, 3) = TT Then

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("E15") = cl.Offset(0, -2)

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("E16") = cl.Offset(0, -1)

        End If

        Next

        

        For Each cl In Workbooks(i).Sheets("ÊÝÕíáí ÇáÊÔÛíáÇÊ").Range("ae4:ae600")

        xx = cl.Offset(0, 3).Value

        If cl = T And cl.Offset(0, 3) = TT Then

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("F15") = cl.Offset(0, -2)

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("F16") = cl.Offset(0, -1)

        End If

        Next

        

        For Each cl In Workbooks(i).Sheets("ÊÝÕíáí ÇáÊÔÛíáÇÊ").Range("AV4:AV600")

        If cl = T And cl.Offset(0, 3) = TT Then

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("G15") = cl.Offset(0, -2)

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("G16") = cl.Offset(0, -1)

        End If

        Next

        

        For Each cl In Workbooks(i).Sheets("ÊÝÕíáí ÇáÊÔÛíáÇÊ").Range("BK4:BK600")

        If cl = T And cl.Offset(0, 3) = TT Then

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("H15") = cl.Offset(0, -2)

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("H16") = cl.Offset(0, -1)

        End If

        Next

        

        For Each cl In Workbooks(i).Sheets("ÊÝÕíáí ÇáÊÔÛíáÇÊ").Range("BZ4:BZ600")

        If cl = T And cl.Offset(0, 3) = TT Then

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("I15") = cl.Offset(0, -2)

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("I16") = cl.Offset(0, -1)

        End If

        Next

        

        For Each cl In Workbooks(i).Sheets("ÊÝÕíáí ÇáÊÔÛíáÇÊ").Range("CO4:CO600")

        If cl = T And cl.Offset(0, 3) = TT Then

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("J15") = cl.Offset(0, -2)

        Workbooks®.Sheets("ÇáÈÍË Úä ÇáÊÔÛíáÇÊ").Range("J16") = cl.Offset(0, -1)

        End If

        Next

        ActiveWorkbook.Save

        ActiveWindow.Close

Next

Application.ScreenUpdating = True

End Sub

هل من شرح لهذا الكود الرائع ، إخواني الكرام ؟

تم تعديل مايو 7, 2014 بواسطه حنفضر

[أحمد مرجان]

دالة أكثر من رائعة بالفعل وتفوقت على دالة Vlookup فى العديد من الأمور

[ناصر سعيد]

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

لو تكرمتم وضعت الداله ومش عارف افعل المعادله

كرما ارجو تضبيطها

================

 

 

258.rar

تم تعديل يناير 1, 2017 بواسطه ناصر سعيد

[ناصر سعيد]

================

وهذا هو الملف الاصلي الموجود به الشرح

 

VLOOKAnyCol.rar