ترحيل وفقا لشروط محدد

[اشرف النعاس]

عند ضغط زر الترحيل يقوم بترحل البيانات المسجلة الى البيانات النهائية في sheet 2 وفقا للشروط التالية في البيانات الحقيقية : 
1- الطالب موجود ضمن البيانات الحقيقية
2- ان تكون قيمة X لهذا الطالب 50 فما فوق

3- ان تكون قيمة Y لهذا الطالب 2 فما فوق

4- ان تكون قيمة Z لهذا الطالب 14 فما فوق
بنسبة للقائمة النهائية تاخد الرغبات الخمسة من البيانات المسجلة
و قيمة X و Y و Z  للطالب من البيانات الحقيقية بحيت تكون القائمة النهائية تحتوي على رقم الطالب و اسمه و رغباته و قيمة X  و Y و Z  لهذا الطالب 
 

اكتر توضيح في الملف المرفق 

New Microsoft Excel Worksheet.rar

[اشرف النعاس]

اريد ان اضيف شي
بنسبة للنقطة الاولى"  الطالب موجود ضمن البيانات الحقيقية "

1- التاكد يتم بواسطة الرقم للطالب اعتقد انها افضل  حيت ان قد يوجد اختلاف بين الاسم في البيانات المسجلة و الحقيقية 
اريد ان اكد ايضا يفضل ان ياخد الاسم في القائمة النهائية من البيانات الحقيقية افضل 

[سليم حاصبيا]

عسى ان يكون المطلوب

New Microsoft Excel Worksheet SALIM.zip

[اشرف النعاس]

اخي سليم بارك الله فيك على الرد 
و لكن النتائج المتوقع من الترحيل هيا
محمد علي ناصر  و علي خليفة فقط حيت هذه الاسماء فقط موجوده في البيانات الحقيقية و المسجلة و ايضا تنطبق عليها الشروط 
بينما عندما قمت بزر بترحيل كانت النتائج هيا علي خليفة و ناصر فؤاد ضاوي ( هذا الاسم لايوجد في البياناتالحقيقية و المسجلة)
و ايضا اريد ان يجلب ايضا الرغبات بجانب البيانات السابقة بحيت تكون البيانات 
الرقم -  الاسم - Z -Y - X- الرغبة الاولى - الرغبة التانية - الرغبة الثالته - الرغبة الرابعة - الرغبة الخامسه 

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

أخي الكريم أشرف

هل الشخص "محمد علي ناصر" سيتم ترحيله؟ لأنني لاحظت أنك وضعت شرط أن تكون القيمة Z أكبر من أو يساوي 14 والقيمة لهذا الشخص هي 12 ..إذاً طبقاً لشروطك لا يتم ترحيل هذه الشخص ..

فقط من تنطبق عليه الشروط هو "علي خليفة"

أكد الكلام أو انفيه حتى تجد المساعدة من إخوانك بالمنتدى

 

كما يمكنك إرفاق النتائج المتوقعة في ملف مرفق بدلاً من الصور لتسهيل المساعدة

تقبل تحياتي

 

تم تعديل سبتمبر 4, 2015 بواسطه ياسر خليل أبو البراء

[اشرف النعاس]

صحيح اخي ياسر كما قلت على خليفة فقط الذي يشمله الشرط انا اسف
النتائج المتوقعه في الملف المرفق 

YU.rar

[اشرف النعاس]

هل من رد 

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

سأحاول العمل على ملفك ليلاً إذا تيسر لي الوقت إن شاء الله وإن لم يتدخل أحد الأخوة الأعضاء

[اشرف النعاس]

بارك الله فيك اخي ياسر 

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

أعتذر عن عدم الوفاء بوعدي بالأمس .. طرأت لي ظروف خارجة عن إرادتي ...

إن شاء الله في أقرب وقت سأقوم بالمحاولة في موضوعك

تقبل تحياتي

[اشرف النعاس]

تمام اخي ياسر بارك الله فيك 

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

أخي الكريم اشرف

جرب الكود التالي عله يفي بالغرض

Sub TransferWithCriteria()
    Dim Source As Worksheet, Target As Worksheet
    Dim LR As Long, I As Long, X As Long
    Dim SourceRange As Range, Found

    Set Source = Sheet1: Set Target = Sheet2

    LR = Source.Cells(Rows.Count, 1).End(3).Row
    X = 8

    Application.ScreenUpdating = False
        Target.Range("D8:T1000").ClearContents
        
        With Source
            For I = 4 To LR
                Found = Application.Match(.Cells(I, "G"), .Range("B4:B" & LR), 0)
                If IsNumeric(Found) Then
                    If .Cells(Found + 3, 3) >= 50 And .Cells(Found + 3, 4) >= 2 And .Cells(Found + 3, 5) >= 14 Then
                        .Cells(Found + 3, 1).Resize(1, 2).Copy
                        Target.Cells(X, "D").PasteSpecial xlPasteValues
                        
                        .Cells(Found + 3, 3).Resize(1, 3).Copy
                        Target.Cells(X, "R").PasteSpecial xlPasteValues
                        
                        Target.Cells(X, "F").Resize(1, 5).Value = .Cells(I, "H").Resize(1, 5).Value
                        X = X + 1
                    End If
                End If
            Next I
        End With
        
        Source.Activate
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    MsgBox "Done.", 64
End Sub

 

Transfer Based On Specific Criteria YasserKhalil.rar

[اشرف النعاس]

بارك الله فيك اخي ياسر ابدعت بصراحة تعجز الكلمات عن شكرك 
لدي فقط تعديل واحد اريده منك هو ان تتم المقارنة ( بين البيانات الحقيقية و المسجلة ) برقم بدلا من الاسم لان في بعض احيان يكتب الاسم ثلاتي بينما في الجانب الاخر تكتب رباعي فيفضل ان تتم المقارنة بالرقم  بدلا عن الاسم

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

جرب تعدل السطر التالي

Found = Application.Match(.Cells(I, "F"), .Range("A4:A" & LR), 0)

 

[اشرف النعاس]

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

[اشرف النعاس]

اريد قائمة اخري "تعديل في كود الاخ ياسر فقط "عند ضغط زر الترحيل 2 يقوم بترحل البيانات المسجلة الى البيانات النهائية في sheet 3  وفقا للشروط التالية في البيانات الحقيقية : 
1- الطالب موجود ضمن البيانات الحقيقية
2- ان يكون للطالب رغبة اخرى "نعم"

بنسبة للقائمة النهائية تحتوي على رقم الطالب و اسمه 

Transfer Based On Specific Criteria YasserKhalil.rar

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

أخي الكريم أشرف

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

عموماً يرجى الإطلاع على التوجيهات مرة أخرى لمعرفة مزيد من التفاصيل

جرب الكود التالي عله يكون المطلوب (وإن كنت لا أحب العمل في نفس الموضوع لأكثر من طلب ..بس عشان خاطر عيونك هعديها المرة دي )

Sub TransferToSheet3()
    Dim Source As Worksheet, Target As Worksheet
    Dim LR As Long, I As Long, X As Long
    Dim SourceRange As Range, Found

    Set Source = Sheet1: Set Target = Sheet3

    LR = Source.Cells(Rows.Count, 1).End(3).Row
    X = 5

    Application.ScreenUpdating = False
        Target.Range("A5:B1000").ClearContents
    
        With Source
            For I = 4 To LR
                Found = Application.Match(.Cells(I, "G"), .Range("B4:B" & LR), 0)
                If IsNumeric(Found) And .Cells(I, "M") = "نعم" Then
                    .Cells(I, "F").Resize(1, 2).Copy
                    Target.Cells(X, "A").PasteSpecial xlPasteValues
                    X = X + 1
                End If
            Next I
        End With
    
        Source.Activate
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

    MsgBox "Done.", 64
End Sub

 

[اشرف النعاس]

السلام عليكم
انا اسف على طرح اكتر من طلب في نفس الموضوع ..... بارك الله فيك اخي ياسر