مقاارنة عمودين فى شيتين مختلفين

[ايمن2010]

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

فى الرابط الاتى http://www.officena.net/ib/index.php?showtopic=36600 ولكنى يبدوا انى لم اوفق فى طريقى شرحى لمطلبى او توهمت انى يمكن ان اخد الفكرة واطبقها على الملف المطلوب ولكنى فشلت والعيب عيبى لذلك ارفقت الملف الاتى املاً ان اجد المساعدة التى اريدها وشكراااً لسعت صدركم اخوكم ايمن

Book1.rar

[بن علية حاجي]

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

أخي الكريم هذه فكرة أخرى في حل هذه المسألة، تم إضافة عمودين في الورقة 1 وعمود في الورقة 2 بمعادلات بحث وترقيم (الأعمدة ملونة بالأصفر)، وهذا الترقيم تم استعماله في الأوراق 3 ، 4 ، 5 لترحيل البيانات المطلوبة بوساطة الدالتين INDEX و MATCH والكل تجده في الملف المرفق (وقد وضعت ملفين أحدهما لنسخة إكسيل 2003 والآخر لنسخة إكسيل 2007 أو 2010 ليستفيد الإخوة منهما)...

أخوك بن علية

Book1.rar

[احمد فضيله]

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

الاخ العزيز / بن عليه

أعمال رائعة

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

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

[بن علية حاجي]

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

أخي الكريم، هذا حل آخر باستعمال المعادلات التي وضعها أخونا الحبيب "الخالدي" (حفظه الله وجزاه الله عنا خير الجزاء) في موضوعك الآخر المشار إليه في الرابط بالأعلى... وقد تم تغيير طفيف على هذه المعادلات والاستغناء في هذه الحالة عن إضافة أعمدة مثلما فعلت في الملف المرفق في ردي السابق... أيضا طبقت تنسيقا شرطيا، على الأعمدة التي وُضعت فيها المعادلات، يقوم بتلوين الخط إلى اللون الأبيض في حالة إرجاع المعادلات القيمة 0... (الملف المرفق هو بتنسيق إكسيل 2003)

أخوك بن علية

Book1_2.rar

[عبد الفتاح كيرة]

فى الشيت الأول

سنضع معادلة لحساب مرات تكرار الاسم فى الشيت الثانى

=COUNTIF('2'!$B$4:$B$100;'1'!B4)

و فى الشيت الثالث سنضع زر مرتبط بماكرو يرحل الأسماء حسب نتيجة المعادلة السابقة صفر أو 1

Sub Button1_Click()

Dim myrng As Range, c1 As Range, i As Long

Application.ScreenUpdating = False

i = 4

     Set myrng = Sheets(1).Range("a4:a100")

    For Each c1 In myrng

        If c1 = 0 Then

            c1.Offset(0, 1).Resize(1, 10).Copy Sheets("3").Range("b" & i)

            i = i + 1

        End If

    Next c1

           Application.ScreenUpdating = True

    Set myrng = Nothing

End Sub

get-kemas.rar

[احمد فضيله]

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

الاخ العزيز / بن عليه

الاخ العزيز / kemas

أعمال رائعة و خبرات كبيرة بسم الله ما شاء الله

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

و جعلكما الله دائماً عوناً للمسلمين

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

[عبد الفتاح كيرة]

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

بل الشكر لك على جهودك الواضحة فى المنتدى

وفقك الله للخير

وهذا هو المطلوب بدون معادلات

حيث دمجت المعادلة فى الكود

Sub Button1_Click()

Dim myrng As Range, c1 As Range, i As Long

Application.ScreenUpdating = False

i = 4

     Set myrng = Sheets(1).Range("b4:b100")

    For Each c1 In myrng

     If Application.WorksheetFunction.CountIf(Sheets("2").Range("b4:b100"), c1) = 0 Then

        c1.Resize(1, 3).Copy Sheets("3").Range("a" & i)

            i = i + 1

        End If

    Next c1

           Application.ScreenUpdating = True

    Set myrng = Nothing

End Sub

get-kemas2.rar

تم تعديل مايو 6, 2011 بواسطه kemas

[أبو محمد أشرف]

السلام عليكم

بارك الله فيكم جميعا

[ايمن2010]

حلول اكثر من رائعة شكرا لكم جزيلاً