مطلوب مساعده في مقارنة كشف حساب البنك

[يوسف احمد]

السلام عليكم

اخواني الاعزاء بالمنتدى

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

 

و المطلرب بالتفصيل في المرفقات

 

شكراً

 

 

مطابقه - مقارنه.rar

تم تعديل مايو 12, 2013 بواسطه يوسف احمد

[جمال عبد السميع]

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

http://www.officena.net/ib/index.php?app=core&module=attach&section=attach&attach_id=63655

تم تعديل مايو 12, 2013 بواسطه جمال عبد السميع

[يوسف احمد]

 استاذ المعادلات الاستاذ الفاضل  / جمال عبد السميع

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

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

ارجو ان اكون استطعت الشرح

 

شكراً لحضرتك مره اخرى

[احمد عبد الناصر]

السلام عليكم

 

جرب هذه 

Sub Button4_Click()
Application.ScreenUpdating = False
x = Cells(Rows.Count, 2).End(xlUp).Row
If x > 2 Then
Range("ba3:ba" & x).Formula = "=b3&c3&d3"
y = Cells(Rows.Count, "h").End(xlUp).Row
If y > 2 Then
Range("bb3:bb" & y).Formula = "=h3&i3&j3"
Range("bc3:bc" & x).FormulaR1C1 = "=COUNTIF(C[-1],RC[-2])"
Range("bd3:bd" & y).FormulaR1C1 = "=COUNTIF(C[-3],RC[-2])"
If x > y Then Z = x Else Z = y
Range("ba3:bd" & Z) = Range("ba3:bd" & Z).Value
For i = 3 To Z
If Cells(i, "bc") > 0 Then
Range("a" & i & ":e" & i).Copy Range("n" & n + 3)
Range("a" & i & ":e" & i).ClearContents
n = n + 1
End If
If Cells(i, "bd") > 0 Then
Range("g" & i & ":k" & i).Copy Range("t" & t + 3)
Range("g" & i & ":k" & i).ClearContents
t = t + 1
End If
Next
Range("ba3:bd" & Z).Clear
Range("a3:e" & x).Sort key1:=Range("a3"), key2:=Range("b3")
Range("g3:k" & x).Sort key1:=Range("g3"), key2:=Range("h3")
End If
End If
Application.ScreenUpdating = True

End Sub

لكن للاسف الكود بطيء نوعا ما , لا اعلم ان كان يفي بالغرض

 

تحياتي

مطابقه++ - مقارنه.rar

[saad abed]

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

Sub Button4_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
x = Cells(Rows.Count, 2).End(xlUp).Row
If x > 2 Then
Range("ba3:ba" & x).Formula = "=b3&c3&d3"
y = Cells(Rows.Count, "h").End(xlUp).Row
If y > 2 Then
Range("bb3:bb" & y).Formula = "=h3&i3&j3"
Range("bc3:bc" & x).FormulaR1C1 = "=COUNTIF(C[-1],RC[-2])"
Range("bd3:bd" & y).FormulaR1C1 = "=COUNTIF(C[-3],RC[-2])"
If x > y Then Z = x Else Z = y
Range("ba3:bd" & Z) = Range("ba3:bd" & Z).Value
For i = 3 To Z
If Cells(i, "bc") > 0 Then
Range("a" & i & ":e" & i).Copy Range("n" & n + 3)
Range("a" & i & ":e" & i).ClearContents
n = n + 1
End If
If Cells(i, "bd") > 0 Then
Range("g" & i & ":k" & i).Copy Range("t" & t + 3)
Range("g" & i & ":k" & i).ClearContents
t = t + 1
End If
Next
Range("ba3:bd" & Z).Clear
Range("a3:e" & x).Sort key1:=Range("a3"), key2:=Range("b3")
Range("g3:k" & x).Sort key1:=Range("g3"), key2:=Range("h3")
End If
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

[يوسف احمد]

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

الاخ الاستاذ / احمد عبد الناصر

سلمت يمينك

عمل ولا اروع الكود يعمل بشكل ممتاز و البطئ ليس كبير

بارك الله فيك و جزاك الله كل خير

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

فبعد اذن حضرتك اريد ان اتعلم كيف اوسع المدى للمقارنه و ما شابه ذلك ... حيث ان شرح حضرتك سوف يفيدني جدا و ربنا يجعله في ميزان حسناتك

 

و هل يمكن استخدام نفس الفكره للمقارنه بين خلايا بها نص

 

عذراً على كثرة الطلبات

اشكرك 

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

[يوسف احمد]

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

الاخ الاستاذ / سعد عابد

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

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

[احمد فضيله]

الاخ الحبيب الاستاذ الكبير / احمد عبد الناصر

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

عمل روعه ... متميز دائماً

سلميت يداك اخي الحبيب

[احمد فضيله]

الاخ الحبيب الاستاذ / سعد عابد

جزاك الله كل خير على الاضافه

و واحشني جدا و الله

[احمد عبد الناصر]

السلام عليكم

 

اسعد الله اوقاتكم

 

استاذ يوسف 

 

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

 

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

 

استاذ سعد شاكر لك مرورك الكريم و بصراحة انا سعيد جدا لدخولك في عالم الاكواد زادك الله علما و نفع بك. 

 

استاذ احمد فضيله شاكر لك مروركم الكريم تقبل تحياتي 

[حمادة عمر]

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

اخي الحبيب / احمد عبد الناصر

 

والشكر موصول للاخ العزيز / سعد عابد علي اضافته

 

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

[احمد فضيله]

 يتنقل للجدولين التاليين و الغير مطابق يكون كما هوا في الجدول مع ترتيبهم

 

 

بعد اذن كل الاخوه يمكن اضافة كود الترتيب التالي قبل

End Sub

في الكود السابق :

''''''          Sort Ascending         ''''''


Range("A3:E65536").Select

    Selection.Sort Key1:=Range("c3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal


Range("G3:K65536").Select

    Selection.Sort Key1:=Range("i3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal


Range("N3:R65536").Select

    Selection.Sort Key1:=Range("p3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal


Range("T3:X65536").Select

    Selection.Sort Key1:=Range("v3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal


Range("N2").Select

MsgBox " Comparison Has Been Completed ", vbInformation, "Confirmation"

و الله المستعان

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

[يوسف احمد]

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