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

طلب المساعدة في حل مشكلة الصفوف الفارغة


إذهب إلى أفضل إجابة Solved by ياسر خليل أبو البراء,

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

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

 

تحية للجميع وكل عام وأنتم بخير

 

الأخوة الكرام يوجد لدي جدول يحتوي على 20.000 صف , بأسماء الموظفين وأرقام هوياتهم والعهد , ومدرج العهد المستلمة من السيارات لكل موظف , والمشكلة هي في حال ان الموظف لديه أكثر من عهدة فإن باقي أصناف العهد تأتيني مدرجة تحت الصف الخاص بالموظف الذي استلم هذه العهد , طبعاً الجدول هذا يأتيني جاهز عن طريق تصديره من برنامج آخر خاص بالعهد , ولا يمكنني التحكم به ,

 

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

 

أعتقد لو شاهدتم الملف ستتضح لكم الصورة أكثر .

 

الورقة الأولى "المشكلة" موضح لكم شكل المشكلة والمطلوب اجراءه لحل المشكلة ولتكون النتيجة كما هو موضح بالورقة الثانية "النتيجة المطلوبة"

 

الورقة الثانية "النتيجة المطلوبة" وهو في حال ايجاد دالة أو طريقة تعطيني النتيجة بالشكل المذكور , بحيث أتخلص من الصفوف الفارغة بعد نقل أو نسخ محتوياتهاإلى الموظف المعني .

 

وشكراً لكم ولجهودكم

تم تعديل بواسطه تعليموه
رابط هذا التعليق
شارك

أخي الكريم تعليموه

إليك الكود التالي عله يفي بالغرض .. سيتم نسخ ورقة العمل المسماة "المشكلة" باسم " النتيجة المطلوبة" وعمل اللازم في ورقة العمل الجديدة

Sub YasserKhalil()
    Dim Rng As Range, DN As Range, nRng As Range, Temp As Range, R As Range
    Dim SHT As Worksheet
    Dim SHP As Shape
    
    Application.DisplayAlerts = False
        On Error Resume Next
        Sheets("النتيجة المطلوبة").Delete
        
        Sheets("المشكلة").Copy After:=Sheets(Sheets.Count)
        Set SHT = ActiveSheet
        SHT.Name = "النتيجة المطلوبة"
        
        With Sheets("النتيجة المطلوبة")
            Set Rng = .Range("A1").Resize(.Range("A1").CurrentRegion.Rows.Count)
            
            For Each SHP In .Shapes
                SHP.Delete
            Next SHP
        
            For Each DN In Rng
                If Not IsEmpty(DN.Value) And Not IsEmpty(DN.Offset(, 1).Value) Then
                    Set Temp = DN.Offset(, 2)
                Else
                    Temp = IIf(IsEmpty(Temp), DN.Offset(, 2).Value, Temp & " - " & DN.Offset(, 2).Value)
                    If nRng Is Nothing Then
                        Set nRng = DN
                    Else
                        Set nRng = Union(nRng, DN)
                    End If
                End If
            Next DN
        
            If Not nRng Is Nothing Then nRng.EntireRow.Delete
            
            With .Range("A1").CurrentRegion
                .BorderAround ColorIndex:=1, Weight:=xlThin
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        End With
    Application.DisplayAlerts = True
End Sub

لا تنسى أن تحدد أفضل إجابة وتضغط على كلمة "أعجبني هذا"

تقبل تحياتي وكل عام وأنت بخير :fff: :fff: :fff:

 

YasserKhalil Officena.rar

  • Like 1
رابط هذا التعليق
شارك

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

 

أخي الكريم أشكرك كل الشكر يالغالي لأنك أعطيتني من وقتك الثمين , وأنا أعجز عن شكرك . ومجهود كبير بذلته لأجل حل مشلتي وأنا مقدر لك هذا المعروف وأشكرك جزيل الشكر .

 

أخي الحبيب لدي فقط بعض الملاحظات آمل منك تكرماً إيجاد حل لها الله يسعدك

 

لو تلاحظ أخي الكريم في الورقة بإسم " المشكلة " فإن السيارة فورد اللي بالصف رقم 12 تم نقلها كعهدة على محمود سعيد في الصف 11 بالورقة بإسم " النتيجة المطلوبة "

 

وأنا أريد نقل العهدة إلى الصف اللي فوقه في حال اذا كان الصف اللي فيه عهدة فارغ ما عادا حقل "عهد السيارات" , أو أنا أحدد ماهي الصفوف اللي المفروض تكون فارغة وفي حال انها فارغة يقوم بنقلها للصف اللي قبله . بمعني ان العهدة اللي بالصف 12 يفترض انها ما  تنتقل إلى خانة العهدة بالصف 11 ما دام هنالك حقل رقم الهوية موجود فيه رقم , يعني النقل يتم مثلاً فقط اذا كان حقل رقم الهوية فارغ والإسم مثلاً , أو فقط رقم الهوية .

 

أيضاً أخي الكريم أريد أن يتم عمل نفس حركة نقل المبالغ من الصف الفارغ إلى الصف اللي فوقه , يعني نفس الحركة اللي بالعمود العهد , طبعاً نقل فقط بدون جمع أو اي عملية حسابية

 

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

 

وبالنسبة لأعجبني أبشر يالغالي باللي يسرك

 

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

 

 

YasserKhalil Officena.rar

رابط هذا التعليق
شارك

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

زيزو العجوز

هذا المقصود والأخ ياسر جزاه الله كل خير وإياك قام بعمل اللازم , لكن الخطأ كان مني بأني وضعت سهم أحمر يوضح نقل البيانات من الصف 12 الى الصف 11

والمفروض أني ماوضعت هذا السهم لأن خانة الهوية في الصف الـ 12 ليست فارغة .

 

وأنا أنتظر منه كراماً إجراء بعض التعديلات .

 

شكراً لكم تعاونكم وجزاكم الله كل خير وبارك فيكم

رابط هذا التعليق
شارك

أخي الكريم

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

يرجى إرفاق ملفك الأصلي للعمل عليه والإطلاع عليه .. ويا ريت تكون النتائج المرفقة المطلوبة صحيحة ...

 

ودلوقتي هل الصف رقم 12 في العمود الثالث كلمة "فورد" تنقل للصف السابق لها أم لا ؟ وإذا لم تنقل لما لا تنقل ؟! هل لوجود بيان في عمود الهوية ؟ وضح بارك الله فيك

تقبل تحياتي

رابط هذا التعليق
شارك

نعم أخي الكريم كلامك صحيح

 

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

 

يعني النقل للصف السابق فقط يتم في حال عدم وجود بيان في عمود الهوية

 

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

 

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

مشكلة الفراغات بالصفوف_3.rar

رابط هذا التعليق
شارك

  • أفضل إجابة

أخي الكريم

جرب الملف بهذا الشكل

 

لا تنسى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي

 

YasserKhalil Officena V2.rar

رابط هذا التعليق
شارك

بسم الله ما شاء الله تبارك الرحمن

 

أسأل الله رب العرش العظيم وفي هذه الساعة الفضيلة أن يجزيك ووالديك خير الجزاء وأن يزيدك علماً وأن يكرمك بالدنيا والآخرة ويفك كل كرب وهم عنك عزيزي

 

كل الشكر والتقدير لك يالغالي , فعلاً أنت مبدع ما شاء الله عليك

  • Like 1
رابط هذا التعليق
شارك

الأخ الفاضل تعليموه

بارك الله فيك وجزيت خيراً على دعائك الطيب المبارك وعلى كلماتك الرقيقة :fff: :fff:

والحمد لله أن تم الموضوع على خير ، وهذا يعلمنا أن نلتزم بالتوجيهات في التوضيح الكافي في المشاركات الأولى حتى لا يطول الموضوع بدون داعي

تقبل تحياتي وكل عام وأنت بخير

رابط هذا التعليق
شارك

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

 

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

 

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

 

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

 

وأكرر شكري وتقديري لك حفظك الله

  • Like 1
رابط هذا التعليق
شارك

أخي الفاضل تعليموه

إليك الكود مع شرح بسيط لأسطر الكود لعله يفي بالغرض ويفيدك في التعديل

Sub YasserKhalil()
'تعريف المتغيرات
    Dim Rng As Range, DN As Range, nRng As Range, Temp As Range, R As Range
    Dim SHT As Worksheet
    Dim SHP As Shape
'إلغاء خاصية رسائل التنبيه
    Application.DisplayAlerts = False
'سطر لتجنب احتمال حدوث خطأ
        On Error Resume Next
'حذف ورقة العمل المسماة النتيجة المطلوبة في حالة وجودها
        Sheets("النتيجة المطلوبة").Delete
'نسخ ورقة العمل المسماة المشكلة في آخر أوراق العمل
        Sheets("المشكلة").Copy After:=Sheets(Sheets.Count)
'تعيين المتغير ليساوي ورقة العمل النشطة
        Set SHT = ActiveSheet
'تسمية ورقة العمل التي تم نسخها باسم النتيجة المطلوبة
        SHT.Name = "النتيجة المطلوبة"
'بدء التعامل مع ورقة العمل المسماة النتيجة المطلوبة
        With Sheets("النتيجة المطلوبة")
'وحتى آخر صف به بيانات في العمود [A1] تعيين المتغير ليساوي النطاق الذي يبدأ من الخلية
            Set Rng = .Range("A1").Resize(.Range("A1").CurrentRegion.Rows.Count)
'حلقة تكرارية لحذف الأشكال مثل الأسهم
            For Each SHP In .Shapes
                SHP.Delete
            Next SHP
'حلقة تكرارية لكل خلية في النطاق الذي تم تعييه في العمود الأول
            For Each DN In Rng
'إذا لم تكن الخلية في العمود الأول فارغة يتم تنفيذ السطر التالي
                If Not IsEmpty(DN.Value) Then
'ليساوي قيمة الخلية في العمود الثالث [Temp] يتم تعيين المتغير
'لاحظ رقم الإزاحة 2 أي الانتقال والإزاحة عمودين بعد العمود الأول
                    Set Temp = DN.Offset(, 2)
'أما في حالة أن الخلية كانت فارغة يتم تنفيذ الأسطر التالية
                Else
'يساوي قيمة الخلية في العمود الثالث إذا كان المتغير فارغ ليس به قيمة بعد [Temp] المتغير
'أما إذا لم يكن المتغير فارغ فإنه يساوي القيمة الموجودة بالفعل مضافاً إليها علامة الشرطة ثم القيمة الجديدة
                    Temp = IIf(IsEmpty(Temp), DN.Offset(, 2).Value, Temp & " - " & DN.Offset(, 2).Value)
'يساوي شيئاً يتم تنفيذ السطر التالي [nRng] إذا لم يكن المتغير المسمى
                    If nRng Is Nothing Then
'تعيين المتغير ليساوي عنوان الخلية الحالية أو النطاق الحالي
                        Set nRng = DN
'وإلا
                    Else
'يتم تعيين المتغير ليساوي النطاق المخزن في المتغير مع نطاق الخلية الحالية
                        Set nRng = Union(nRng, DN)
                    End If
                End If
            Next DN
'[nRng] حذف الصفوف التي تكون الخلية في العمود الأول فيها فارغة والتي تم تخزيناه في النطاق المسمى
            If Not nRng Is Nothing Then nRng.EntireRow.Delete
'بدء التعامل مع النطاق الحالي
            With .Range("A1").CurrentRegion
'رسم حدود خارجية للنطاق باللون الأسود والخط الرفيع
                .BorderAround ColorIndex:=1, Weight:=xlThin
'التوسيط الأفقي للبيانات
                .HorizontalAlignment = xlCenter
'التوسيط الرأسي للبيانات
                .VerticalAlignment = xlCenter
            End With
        End With
'إعادة تفعيل خاصية رسائل التنبيه
    Application.DisplayAlerts = True
End Sub

لا تنسانا بدعوة على الإفطار (مش دلوقتي .. ساعة الإفطار)

تقبل الله منا ومنكم :fff: :fff: :fff:

رابط هذا التعليق
شارك

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