مقارنة البيانات من اكثر من شيت وتجميعها في جدول واحد

[عبدالله فريد]

المطلوب عن الضغط على زر ادخال يظهر لي صندوق لللدخال الرقم وعند ادخال الرقم يقوم بمقارنة و الفرز بين شيت A&N          اذا كان الرقم موجود او غير موجود في اي من الشيت الاول و الثاني يتم وظعو تلقائيا في الجدول الرءيسي كما هو موضح 

فرز الارقام.rar

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

أخي الكريم عبد الله

جرب الكود التالي

Public Sub FindNames()
    Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet, Report As Worksheet
    Dim FindRange As Range, SearchRange1 As Range, SearchRange2 As Range
    Dim R As Long, LastRow1 As Long, LastRow2 As Long, LastRowReport As Long
    Dim X

    Set Sh1 = ThisWorkbook.Worksheets("a")
    Set Sh2 = ThisWorkbook.Worksheets("n")
    Set Report = ThisWorkbook.Sheets("الجدول الرئيسي")

    LastRow1 = Sh1.Cells(Sh1.Rows.Count, 1).End(xlUp).Row
    LastRow2 = Sh2.Cells(Sh2.Rows.Count, 1).End(xlUp).Row
    LastRowReport = Report.Cells(22, 1).End(xlUp).Row

    Set SearchRange1 = Sh1.Range(Sh1.Cells(2, 1), Sh1.Cells(LastRow1, 1))
    Set SearchRange2 = Sh2.Range(Sh2.Cells(2, 1), Sh2.Cells(LastRow2, 1))

    X = InputBox("Enter The Item To Search", "Search Box")
    On Error Resume Next

    Set FindRange = SearchRange1.Find(What:=X)
    If Not FindRange Is Nothing Then
        Set FindRange = CheckForMore(FindRange, SearchRange1)
        Report.Cells(LastRowReport + 1, 1).Value = Sh1.Cells(FindRange.Rows.Row, 1).Value
    End If

    Set FindRange = SearchRange2.Find(What:=X)
    If Not FindRange Is Nothing Then
        Set FindRange = CheckForMore(FindRange, SearchRange2)
        Report.Cells(LastRowReport + 1, 2).Value = Sh2.Cells(FindRange.Rows.Row, 1).Value
    End If
End Sub

Public Function CheckForMore(Arg As Range, SearchRange As Range) As Range
    Dim FindRange As Range
    Dim Count As Long

    Set FindRange = Arg
    Do
        Set FindRange = SearchRange.Find(What:=Arg.Value, After:=FindRange(1))
        Debug.Print Arg.Address, FindRange.Address
        Count = Count + 1
    Loop Until FindRange.Address = Arg.Address
    If Count > 1 Then MsgBox "There Is More Than One " & Arg.Value & "!" & vbCrLf & "Only The First One Has Been Done."

    Set CheckForMore = FindRange
End Function

تم وضع معادلات في العمود الثالث ..

أرجو أن يكون المطلوب ..

تقبل تحياتي

 

فرز الارقام.rar

[عبدالله فريد]

اخي ابو البراء مشكور جدا ما شاء الله عليك 

 

استفسار 

انا اريد عن ضغط الرقم وعند عمل الفرز الرقم  اريد جلب فقط البيانات الغير موجودة فقط اما اذا كانت موجودة لا اريدها ومن ثم اذا كانت غير موجوة في a وموجودة في n

يتم وضع الرقم في  عامود a

ارجو التعديل ابو البراء اذا امكن

يعني المكان الغير موجودة فيه تظهر في العمود التي تنتمي اليه 

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

أخي الكريم عبد الله

الموضوع فيه لبس وعدم وضوح بالنسبة لي ..يرجى إرفاق شكل النتائج المتوقعة ..خفف من البيانات بحيث تتضح الصورة ..يكفي 20 صف في كل ورقة عمل وعلى أساس البيانات ارفق شكل النتائج المتوقعة ليسهل تقديم المساعدة من قبل إخوانك ..

ضاع وقتك يا صاااااااااابر في كود ملوش لازمة !! خير اللهم اجعله خير ..

 

[عبدالله فريد]

ههههههههههه

 

اخي ابا البراء بالعكس ما عملته لي ما هو المطلوب و اكثر من المتوقع 

ولكن كان مجرد استفسار للعلم بالشي      مشكورررررررررررر  جدا 

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

حسناً أخي الحبيب عبد الله

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

تقبل تحياتي وتصبح على خير

[عبدالله فريد]

اخي ابو الراء السلام عليكم 

 

ارجو المساعدة في الكود اعلاه 

 

ارجو الانتباه على المرفق انه الصف الرئيسي مروس ب 

غير موجود في n  غير موجود في a         والكود يظهر لي العكس ارجو ازالة تصفية البيانات عن الجدول 

 

ارجو المساعدة و شكرا