السلام عليكم
=====
اليوم ساقدم لكم استخدام مبهر للدالة VLOOKUP
تعودنا ان الدالة VLOOKUP تبحث عن قيمة معينة فى نطاق محدد " فى صفحة محددة"
اليوم ستقوم الدالة VLOOKUP بالبحث عن قيمة محددة فى عدة نطاقات وفى عدة صفحات
الدالة اسمها multvlookup وهى من النوع U D F
Option Explicit[/b]
[b]Public Function MultVlookup( _[/b]
[b] FindThis As Variant, _[/b]
[b] LookIn As Range, _[/b]
[b] SheetRange As String, _[/b]
[b] OffsetColumn As Integer) _[/b]
[b] As Variant[/b]
[b]Dim Sheet As Worksheet[/b]
[b]Dim strFirstSheet As String[/b]
[b]Dim strLastSheet As String[/b]
[b]Dim SheetArray() As String[/b]
[b]Dim blnFirstSheet As Boolean[/b]
[b]Dim rngFind As Range[/b]
[b]Dim blnFound As Boolean[/b]
[b]Dim n As Integer[/b]
[b]'جعل نطاق البحث عمود واحد[/b]
[b]If LookIn.Columns.Count > 1 Then[/b]
[b] Set LookIn = LookIn.Resize(LookIn.Rows.Count, 1)[/b]
[b]End If[/b]
[b]'حجم الصفيف لاحتواء كافة أسماء ورقة عمل[/b]
[b]ReDim SheetArray(ActiveWorkbook.Worksheets.Count)[/b]
[b]'الحصول على أسماء ورقة العمل[/b]
[b]strFirstSheet = Left(SheetRange, InStr(1, SheetRange, ":") - 1)[/b]
[b]strLastSheet = Right(SheetRange, _[/b]
[b] Len(SheetRange) - InStr(1, SheetRange, ":"))[/b]
[b]'وضع أسماء ورقة عمل في "نطاق ورقة" مجموعة في صفيف[/b]
[b]blnFirstSheet = False[/b]
[b]n = 0[/b]
[b]For Each Sheet In ActiveWorkbook.Worksheets()[/b]
[b] If Sheet.Name = strFirstSheet Then[/b]
[b] blnFirstSheet = True[/b]
[b] End If[/b]
[b] If blnFirstSheet = True Then[/b]
[b] SheetArray(n) = Sheet.Name[/b]
[b] n = n + 1[/b]
[b] End If[/b]
[b] If Sheet.Name = strLastSheet Then[/b]
[b] blnFirstSheet = False[/b]
[b] End If[/b]
[b]Next Sheet[/b]
[b]'نطاق البحث في كل ورقة عمل في مجموعة[/b]
[b]blnFound = False[/b]
[b]For n = 0 To UBound(SheetArray, 1)[/b]
[b] With Worksheets(SheetArray(n)).Range(LookIn.Address)[/b]
[b] Set rngFind = .Find(FindThis, LookIn:=xlValues, _[/b]
[b] MatchCase:=False, LookAt:=xlWhole)[/b]
[b] End With[/b]
[b] If Not rngFind Is Nothing Then[/b]
[b] 'ايجاد النتيجة[/b]
[b] blnFound = True[/b]
[b] End If[/b]
[b] If blnFound = True Then Exit For[/b]
[b]Next n[/b]
[b]'عودة القيمة[/b]
[b]If blnFound = True Then[/b]
[b] MultVlookup = rngFind.Offset(0, OffsetColumn - 1)[/b]
[b] Else[/b]
[b] MultVlookup = "Not Found"[/b]
[b]End If[/b]
[b]End Function[/b]
[b]
وسوف لا اتكلم كثيرا فالدالة تتحدث عن نفسها
المساعدة.rar