اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

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

هذا هو المطلوب فعلا

ولكن هل من الممكن

Sub ÍÓÈ_ÇáÇÎÊíÇÑ()
Application.ScreenUpdating = False
Dim c As Range
Sheet2.Range("b7:d300") = Empty
For Each c In Sheet1.Range("chose")
If c.Value = "äÚã" Then
' Z = Z + 1
lstrow = Sheet2.Range("b20000").End(xlUp).Row + 1
Sheet2.Range(Sheet2.Cells(lstrow, "b"), Sheet2.Cells(lstrow, "i")) = _
Sheet1.Range(Sheet1.Cells(c.Row, "b"), Sheet1.Cells(c.Row, "i")).Value
'Sheet2.Cells(lstrow, "a") = Z:
Sheets("ÇáÃÓÇÓííä").Select
Range("b7").Select
End If
Next c
MsgBox ("Êã ÊÑÍíá ÇáÕÝæÝ ÇáãÍÏÏÉ ÈäÌÇÍ"), vbDefaultButton1, " ÊÍíÇÊí à / ãÍÜãÜæÏ ÌÜãÜÚÜå "
If b Then cel.EntireRow.Delete
Set cel = Nothing
End Sub



 

1- شرح لهذا الكود المرفق بالملف والخاص بترحيل البيانات مع شرح لخطوات تصميمه وذلك حتي أستطيع ويستطيع غيري كيفية القيام بعمل مثل هذا الكود .

 

 

2- مطلوب التعديل علي هذا الكود ليقوم بالآتي

أ- ترحيل بيانات الصف الذي نقوم بكتابة أمامه نعم إلي صفحة المستبعدين ومسحه من صفحة الأساسيين .

 

3- طلب أخر هل من الممكن عند الترحيل يظهر مربع حواري لكتابة سبب حذف هذه الأسرة

4- وأخيراً عمل كود لعدم ترك الخلايا B:i  فارغة وعند ترك خلية فارغة والقيام بإختيار كلمة نعم أو إجراء عملية الترحيل تظهر رسالة بذلك مع تحديد الخلية الفارغة .

قام بنشر

أخي الفاضل لا تكثر من الطلبات فينفر الأخوة من الموضوع ..خليك محدد طلب واحد ولما ينتهي الطلب الأول انتقل لطلب ثاني وهكذا..

إليك الطلب الأول شرح الكود

Sub حسب_الاختيار()
    'الغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
        'تعريف المتغير
        Dim c As Range
        'مسح نطاق النتائج
        Sheet2.Range("b7:d300") = Empty
        For Each c In Sheet1.Range("chose")
            'تساوي كلمة نعم[chose]إذا كانت الخلية داخل النطاق المسمى
            If c.Value = "نعم" Then
                'متغير يحمل قيمة آخر صف به بيانات في ورقة النتائج بالعمود الثاني مضافاً إليها رقم 1 استعداداً لبيان جديد
                lstrow = Sheet2.Range("b20000").End(xlUp).Row + 1
                'يساوي نفس النطاق في ورقة الأساسيين[I]إلى العمود[B]النطاق في ورقة النتائج من العمود
                Sheet2.Range(Sheet2.Cells(lstrow, "b"), Sheet2.Cells(lstrow, "i")) = _
                Sheet1.Range(Sheet1.Cells(c.Row, "b"), Sheet1.Cells(c.Row, "i")).Value
                'Sheet2.Cells(lstrow, "a") = Z:
                'تحديد ورقة الأساسيين
                Sheets("الأساسيين").Select
                '[B7]تحديد الخلية
                Range("b7").Select
            End If
        Next c
        'رسالة تفيد بانتهاء عملية الترحيل
        MsgBox ("تم ترحيل الصفوف المحددة بنجاح"), vbDefaultButton1, " تحياتي أ / محـمـود جـمـعـه "
        
    'تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

  • Like 1
قام بنشر

الأخ الحبيب Yasser Khalil

جزاك الله كل خير علي هذا المجهود وسأعمل بنصائحك

وهذا هو الطلب الثاني

* كيفية ترحيل بيانات الصف الذي نقوم بكتابة أمامه نعم إلي صفحة المستبعدين ومسحه من صفحة الأساسيين .

قام بنشر

أخي الفاضل محمود

الترحيل تم بموجب الكود المرفق . بقي فقط نقطة أخيرة ::: هل تريد حذف الصف بالكامل أم مسح محتوياته فقط والإبقاء على الصف كما هو ...؟؟

قام بنشر (معدل)

أخي الكريم ياسر الملف به بعض الملاحظات

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

 

ولكن الكود لايقوم بترحيل أكثر من ثلاث صفوف وبعدها لايقوم بترحيل أي صف آخر

Families Data-2.rar

تم تعديل بواسطه Mahmoud330
قام بنشر

جرب الكود بهذا الشكل

قمت عن الاستغناء عن النطاق المسمى chose والاستدلال عليه بالأكواد K7:K وآخر صف به بيانات

Sub حسب_الاختيار()
    'الغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
        'تعريف المتغير
        Dim c As Range
        For Each c In Sheet1.Range("K7:K" & Cells(Rows.Count, 2).End(xlUp).Row)
            'تساوي كلمة نعم[chose]إذا كانت الخلية داخل النطاق المسمى
            If c.Value = "نعم" Then
                'متغير يحمل قيمة آخر صف به بيانات في ورقة النتائج بالعمود الثاني مضافاً إليها رقم 1 استعداداً لبيان جديد
                lstrow = Sheet2.Range("b20000").End(xlUp).Row + 1
                'يساوي نفس النطاق في ورقة الأساسيين[I]إلى العمود[B]النطاق في ورقة النتائج من العمود
                Sheet2.Range(Sheet2.Cells(lstrow, "B"), Sheet2.Cells(lstrow, "I")) = _
                Sheet1.Range(Sheet1.Cells(c.Row, "B"), Sheet1.Cells(c.Row, "I")).Value
                'مسح بيانات الصفوف التي تم ترحيلها
                Sheet1.Range(Sheet1.Cells(c.Row, "B"), Sheet1.Cells(c.Row, "K")).ClearContents
                'تحديد ورقة الأساسيين
                Sheets("الأساسيين").Select
                '[B7]تحديد الخلية
                Range("b7").Select
            End If
        Next c
        
        'رسالة تفيد بانتهاء عملية الترحيل
        MsgBox ("تم ترحيل الصفوف المحددة بنجاح"), vbDefaultButton1, " تحياتي أ / محـمـود جـمـعـه "
        
    'تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

قام بنشر

الأخ الكريم ياسر

جزاك الله كل خير علي إهتمامك ومجهودك الرائع

ولكن توجد بعض الملاحظات الصغيرة

1- الكود يقوم بتكرار الأسماء والأرقام التي تم ترحيلها إلي صفحة المستبعدين .

والمطلوب

( أنه مهما تكرر الرقم والإسم معاً في صفحة الأساسيين أن يقوم الكود بمسحه من صفحة الأساسيين ولكن لايقوم بتكراره في صفحة المستبعدين )

( أما إذا تكرر الإسم مع رقم مختلف يقوم الكود بنقله إلي صفحة المستبعدين في صف جديد )

( معني ذلك أنه لايتم تكرار أي رقم موجود في صفحة المستبعدين مهما كان صفه يحتتوي علي أي بيانات )

 

Families Data-3.rar

 

 

 

 

قام بنشر

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

قام بنشر

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

تعبتني معاك

اكتب كلمة نعم في العمود K ليتم استبعاده

مش دا شرط الاستبعاااااااااااااااااااااااااااااد ....!!

هاصرخ في وشك دلوقتي وأقولك إنت حبيبي والله

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information