حذف الأعمدة التي مجموع خلاياها يساوي صفر

[أحمد عياد - أبو علي]

أساتذتي الأفاضل:

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

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

  () Sub Delete_Zero
  
   For i = 2 To 183
   If Cells(284, i) = 0 Then
       Cells(284, i).EntireColumn.Delete
       
       End If
       Next i
       
    
End Sub

 

 

Delete zero.rar

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

استبدل الرقم 183 في السطر   For i = 2 To 183 بـ 284

اليك الكود التالي الذي يقوم بنفس العمل و اسرع بكثير 

حيث انه يقوم بتجميع كل الاعمدة المطلوبة وحذفها دفعة واحدة

Sub Delete_Zero()
      Dim rg_to_del As Range, i As Integer
       Application.ScreenUpdating = False
      For i = 2 To 284
    If Cells(284, i) = 0 Then
            If rg_to_del Is Nothing Then
             Set rg_to_del = Cells(284, i)
             Else
             Set rg_to_del = Union(Cells(284, i), rg_to_del)
            End If
     End If
        Next i
       rg_to_del.EntireColumn.Delete
       
    Application.ScreenUpdating = True
End Sub

 

[أحمد عياد - أبو علي]

1 ساعه مضت, سليم حاصبيا said:

استبدل الرقم 183 في السطر   For i = 2 To 183 بـ 284

اليك الكود التالي الذي يقوم بنفس العمل و اسرع بكثير 

حيث انه يقوم بتجميع كل الاعمدة المطلوبة وحذفها دفعة واحدة

Sub Delete_Zero()
      Dim rg_to_del As Range, i As Integer
       Application.ScreenUpdating = False
      For i = 2 To 284
    If Cells(284, i) = 0 Then
            If rg_to_del Is Nothing Then
             Set rg_to_del = Cells(284, i)
             Else
             Set rg_to_del = Union(Cells(284, i), rg_to_del)
            End If
     End If
        Next i
       rg_to_del.EntireColumn.Delete
       
    Application.ScreenUpdating = True
End Sub

 

بارك الله بك أستاذي الفاضل سليم على هذا الجهد الرائع.

وكي أزداد علما ومعرفة هل لك ان تشرح لي الخلل الذي كان في المعادلة التي كنت استخدمها؟

بوركت...

 

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

أخي العزيز أحمد

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

For i = 2 To 183

استخدم السطر التالي بدلاً من هذا السطر

For i = 183 To 2 Step -1

 

[الصـقر]

اخى الكريم

جرب ايضا هذا الكود يفى بالغرض

Sub Delete_Zero()
Application.ScreenUpdating = False
    lc = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
    lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
   For i = lc To 3 Step -1
   If Application.WorksheetFunction.Sum(Sheet1.Range(Cells(3, i), Cells(lr, i))) = 0 Then
       Columns(i).Delete Shift:=xlToLeft
       End If
       Next i
    Application.ScreenUpdating = True
End Sub

وبهذا الكود انت لا تحتاج الى الصف رقم 284 اللى فيه مجموع الاعمده فانت فى غنى عنه

تقبل تحياتى

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

4 ساعات مضت, أحمد عياد - أبو علي said:

بارك الله بك أستاذي الفاضل سليم على هذا الجهد الرائع.

وكي أزداد علما ومعرفة هل لك ان تشرح لي الخلل الذي كان في المعادلة التي كنت استخدمها؟

بوركت...

 

الخلل كما ذكرت لك هو في السطر For حبث ان الرقم بجب ان يكون 284 و ليس 183

تم تعديل أبريل 5, 2016 بواسطه سليم حاصبيا

[أحمد عياد - أبو علي]

20 ساعات مضت, سليم حاصبيا said:

الخلل كما ذكرت لك هو في السطر For حبث ان الرقم بجب ان يكون 284 و ليس 183

قمت بتجربة ذلك، ولم تكن النتيجة صحيحة وكاملة، كذلك قمت بزيادة الرقم الى أكثر من ذلك بكثير وبقيت نفس المشكلة.

في ٥‏/٤‏/٢٠١٦ at 14:49, ياسر خليل أبو البراء said:

أخي العزيز أحمد

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

For i = 2 To 183

استخدم السطر التالي بدلاً من هذا السطر

For i = 183 To 2 Step -1

 

جزاك الله خير أخي وأستاذي الفاضل أبو البراء