المقارنة بين جدولين بالكود

[skyblue]

السلام عليكم ورحمة الله وبركاته :

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

لذا ارفق الملف واتمنى من الاساتذة الكرام التعديل عليه جزاكم الله كل خير

[علي السحيب]

تتم المقارنة بين الجدولين عن طريق الكود التالي:

Sub Compare()

[B16:C65536,E16:F65536].ClearContents

For R = 3 To 9

If Application.WorksheetFunction.CountIf([E3:E9], Cells(R, 2)) = 0 Then
With Columns(2).Rows(65536).End(xlUp)

            .Offset(1, 0) = Cells(R, 2)
            .Offset(1, 1) = Cells(R, 3)
End With
End If
Next

For R = 3 To 9

If Application.WorksheetFunction.CountIf([B3:B9], Cells(R, 5)) = 0 Then
With Columns(5).Rows(65536).End(xlUp)

            .Offset(1, 0) = Cells(R, 5)
            .Offset(1, 1) = Cells(R, 6)
End With
End If
Next

MsgBox "تمت المقارنة بين الجدولين بنجاح", vbInformation, "تمت المقارنة"
End Sub

شاهد المرفق،

_______________________________.rar

[skyblue]

رائع رائع يااستاذ علي على هذا الانجاز الكبير في كود المقارنة .

وطلب بسيط على الرغم من خجلي الشديد منكم لكثرة طلباتنا ومانلاقيه منكم من طيبة وكرم .

ياليت تجعل نتيجة المقارنة في صفحة اخرى ولتكن sheet2

والله ياخوي علي ماني عارف كيف نرد لك الجميل فقد خدمتنا خدمات كثيرة جدا لاتقدر بثمن ولكن ليس لنا الا الدعاء لك دوما في ظهر الغيب .

وتقبل تحياتي واحترامي الشديد لك

[علي السحيب]

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

Sub Compare2()

Sheet2.[B3:C65536,E3:F65536].ClearContents

For R = 3 To 9

If Application.WorksheetFunction.CountIf(Sheet1.[E3:E9], Sheet1.Cells(R, 2)) = 0 Then
With Sheet2.Columns(2).Rows(65536).End(xlUp)

            .Offset(1, 0) = Sheet1.Cells(R, 2)
            .Offset(1, 1) = Sheet1.Cells(R, 3)
End With
End If
Next

For R = 3 To 9

If Application.WorksheetFunction.CountIf(Sheet1.[B3:B9], Sheet1.Cells(R, 5)) = 0 Then
With Sheet2.Columns(5).Rows(65536).End(xlUp)

            .Offset(1, 0) = Sheet1.Cells(R, 5)
            .Offset(1, 1) = Sheet1.Cells(R, 6)
End With
End If
Next

MsgBox "!أنتهت عملية المقارنة بين الجدولين بنجاح وتم وضع النتائج في الصفحة الثانية", vbInformation, "نتيجة المقارنة"
End Sub

شاهد المرفق،

_______________________________.rar

[skyblue]

شكرا لك اخوي علي وسامحني اذا اتعبتك معي لانني والله انني احبك في الله ودوما ادعي لك بالخير

وبالذات في هذه الليالي المباركة فانت تستاهل كل خير طيبة واخلاق وعلم .

ادعوا الله الذي لااله الاهو الاحد الصمد ان يحفظك من كل شر وان يرزقك من حيث لاتحتسب وان يطيل في عمرك ويرزق الجنة .......أمين

[skyblue]

استاذي الفاضل : علي السحيب حفظه الله

لقد جربت ملف المقارنة فكان يعطي نتائج ممتازة جدا ولكن لو كان هناك عدد 2 مكرر 3 مرات مثلا في الجدول الاول .

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

فياليت التعديل على البرنامج بحيث يظهر العدد 2 مكرر مرتين في الجدول الاول ,, والجدول الثاني لاتوجد اعداد مكررة

وتقبل تحياتي

مرفق

[skyblue]

للتذكير فقط ...

تحياتي الغالية لاستاذي علي السحيب

[علي السحيب]

تخيل أني فتحت المنتدى لأضع الرد على سؤالك .. ففوجئت بك تذكرني به،

على كل حال الكود التالي ينفذ ما طلبته .. مع ملاحظة أنه مرتبط بالكود السابق وكلاهما يعمل بضغطه زر واحدة وعلى نفس ورقة العمل أو على ورقة عمل أخرى.

Sub Duplicated()

Set MyRange1 = [K16:K22]
Set MyRange2 = [H16:H22]

[H16:I22,K16:L22].ClearContents

For R = 3 To 9
If Application.WorksheetFunction.CountIf([E3:E9], Cells(R, 5)) > 1 Then
With Columns(8).Rows(65536).End(xlUp)
            .Offset(1, 0) = Cells(R, 5)
            .Offset(1, 1) = Cells(R, 6)
End With
End If
Next

For R = 3 To 9
If Application.WorksheetFunction.CountIf([B3:B9], Cells(R, 2)) > 1 Then
With Columns(11).Rows(65536).End(xlUp)
            .Offset(1, 0) = Cells(R, 2)
            .Offset(1, 1) = Cells(R, 3)
End With
End If
Next

For Each Cell In MyRange1
A = Application.WorksheetFunction.CountIf([B3:B9], Cell)
B = Application.WorksheetFunction.CountIf([E3:E9], Cell)
C = A - B
If Application.WorksheetFunction.CountIf(MyRange1, Cell) > C Then
Cell.ClearContents
Cells(Cell.Row, Cell.Column + 1).ClearContents
End If
Next

For Each Cell In MyRange2
A = Application.WorksheetFunction.CountIf([B3:B9], Cell)
B = Application.WorksheetFunction.CountIf([E3:E9], Cell)
C = B - A
If Application.WorksheetFunction.CountIf(MyRange2, Cell) > C Then
Cell.ClearContents
Cells(Cell.Row, Cell.Column + 1).ClearContents
End If
Next

[H16:I22].Sort [H16], xlAscending
[K16:L22].Sort [K16], xlAscending

End Sub

شاهد المرفق،

________________________________2.rar

[skyblue]

محفوظ باذن الله من كل شر ياعلي السحيب ابداع في ابداع وتميز بلا حدود ماشاء الله عليك انت البحر في احشائه الدر كامن .

تحياتي الغالية لك ومكانك الحقيقي في قلوبنا .

[علي السحيب]

شكراً لك أخي الكريم،

[abada mahdy]

شكرا لك استاذى على

واريد المقارنة بين الجدولين بالمرفق

_____________2007.rar

[abada mahdy]

لعل المانع خير

[علي السحيب]

هل تعتقد أن سؤالك واضح؟؟ حتى أنك لم تحدد نوع المقارنة التي تريد،

[abada mahdy]

اسف استاذى الفاضل

وارجو ان يكون طلبى واضح

اخوك عباده مهدى

_____________2007.rar

[علي السحيب]

هل رأيت .. سؤال واضح = إجابة واضحة،

شاهد المرفق،

_______________________________.rar

[abada mahdy]

استاذى الفاضل / على حسين السحيب
جزاك الله خيرا
على هذا العمل الجميل والمفيد
وجعله ميزان حسناتك

ارجو توضيح هذه الكلمات فى البرمجة (الكود):
Resume
.Offset(1, -1)
.Offset(1, 0)
.Offset(1, 1)

اخوك
عبادة مهدى