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

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

قام بنشر

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

قام بنشر

أخي لحذف الأسطر غير المستخدمة جرب هذا الكود

Sub DeleteMyRow()

Dim LR As Integer

LR = Range("A" & Rows.Count).End(xlUp).Row

	For i = LR To 1 Step -1

    	If Range("A" & i).Value = "" Then

    	Range("a" & i).EntireRow.Delete

    	End If

	Next i

End Sub
و لحذف الأعمدة غير المستخدمة جرب هذا الكود
Sub DeleteMyColumn()

Dim LC As Integer

LC = Cells(1, Columns.Count).End(xlToLeft).Column

	For y = LC To 1 Step -1

    	If Cells(1, y) = "" Then

    	Cells(1, y).EntireColumn.Delete

    	End If

	Next y


End Sub

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

أخي يحيى حسين

اسمح لي بقليل من التعليق

وهو أنك اعتمدت في الأكواد السابقة على فراغ الخلية الأولى من كل صف حتى يتم حذفه فمن الممكن أن تكون الخلية الأولى فارغة وباقي الخلايا مكتوب فيه أو العكس

وبالفعل تم مناقشة هذا الموضوع في منتدى آخر وعرض أحد الإخوة هذه الدالة التي تقوم بحذف الصفوف الفارغة

Sub deleteEmptyRows()

Dim LastRow As Integer

Dim MyRow As Integer

Application.ScreenUpdating = False

LastRow = ActiveSheet.UsedRange.Row - 1 + _

ActiveSheet.UsedRange.Rows.Count

For MyRow = LastRow To 1 Step -1

If Application.CountA(Rows(MyRow)) = 0 Then Rows(MyRow).delete

Next MyRow

Application.ScreenUpdating = True

End Sub
ولكني لاحظت أنها تقوم بحذف الأسطر الفارغة صفا صفا وكنت قد بحثت في فترة سابقة على النت فوجدت هذه الدالة التي تعتمد على حذف المناطق الفارغة مما يزيد سرعة عملية الحذف
Sub DeleteBlankRows()

    Set myrange = Range("B4:I31")

    Set blanks = myrange.SpecialCells(xlCellTypeBlanks)

    For Each area In blanks.Areas

        If area.Columns.Count = myrange.Columns.Count Then

            area.EntireRow.Delete

        End If

    Next area

End Sub
وهذه دالة من تصميمي بناء على الدالة الأولى مع بعض التعديلات
Sub Mas_DelBlankRows()

On Error Resume Next

  Dim n As Integer

    For n = 1 To ActiveSheet.UsedRange.SpecialCells(4).Areas.Count

       If ActiveSheet.UsedRange.SpecialCells(4).Areas(n).Columns.Count = ActiveSheet.UsedRange.Columns.Count Then ActiveSheet.UsedRange.SpecialCells(4).Areas(n).EntireRow.Delete

    Next n

End Sub

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

وبالله التوفيق

أخوكم

محمد صالح

تم تعديل بواسطه mas123
  • Like 2
قام بنشر

اشكر الاساتذة لمساهمتهم الممتازة

ولكن الفكرة من المسح هو تقليل عدد الصفوف و الاعمدة

مثال يوجد فى الاكسل حوالى 36000 صف فى الشيت وانا مستخدم 20 صف

اريد ال 20 صف فقط فى الشيت من غير ما اعمل اخفاء اريد ازالة الصفوف الفارغة

ولكم كل الشكر

قام بنشر

اتصور ان الازالة غير ممكنة

حقيقة هناك احتياج لكل من الحالتين

الحذف بناء على خلية

و ايضا الحذف بناء على السطر الكامل و لكل استخداماته :smile2:

أخي ماس الدالة الأولي تعمل بكفائة

أما الثانية فلم تعمل معي

قام بنشر

أخي لا يمكنك تنفيذ طلبك

فحجم و عدد الاسطر و الأعمدة في الاكسيل ثابت

و لاحظ عند قيامك بحذف سطر سيقوم الاكسيل تلقائياً بإعادته مرة أخرى

===========

و للعلم هذه الزيادة لا تؤثر على حجم الملف او سرعة العملية الحسابية بداخله

===========

أخي محمد صالح

الكود قمت بعمله بناء على طلب الاخ بحذف سطر او عمود و هذا يعني فراغ السطر و العمود كاملاُ

:)

قام بنشر

أخي لحذف الأسطر غير المستخدمة جرب هذا الكود

Sub DeleteMyRow()

Dim LR As Integer

LR = Range("A" & Rows.Count).End(xlUp).Row

	For i = LR To 1 Step -1

    	If Range("A" & i).Value = "" Then

    	Range("a" & i).EntireRow.Delete

    	End If

	Next i

End Sub
و لحذف الأعمدة غير المستخدمة جرب هذا الكود
Sub DeleteMyColumn()

Dim LC As Integer

LC = Cells(1, Columns.Count).End(xlToLeft).Column

	For y = LC To 1 Step -1

    	If Cells(1, y) = "" Then

    	Cells(1, y).EntireColumn.Delete

    	End If

	Next y


End Sub
.... أخي محمد صالح الكود قمت بعمله بناء على طلب الاخ بحذف سطر او عمود و هذا يعني فراغ السطر و العمود كاملاُ :)
أخي يحيى وفقنا الله وإياكم إلى ما يحب ويرضى أليس معنى هذا الجزء من الكود
	For i = LR To 1 Step -1

    	If Range("A" & i).Value = "" Then

    	Range("a" & i).EntireRow.Delete

    	End If

	Next i
أنه بعدد الصفوف يتم تكرار الشرط إذا كانت قيمة الخلية a1 تساوي "" أي لا شيء يتم حذف الصف الذي يحتوي على هذه الخلية وهكذا مع الخلية a2 , a3 , a4, a5 وهكذا وبالنسبة لأخي محمد طاهر بنا يكون في عونه لما يحدث ونبارك لنا وله عودة هذا الصرح التعليمي الكبير الدالة المقدمة مني هي عبارة عن دمج للدالتين ولكن الخطأ بها يعود غلى حالة وجود أكثر من صف في النطقة الفارغة وتم معالجة هذا الأمر في الدالة التالية
Sub masDeleteBlankRows()

     For Each area In ActiveSheet.UsedRange.SpecialCells(4).Areas

        If area.Columns.Count = ActiveSheet.UsedRange.Columns.Count Then

            n = n + 1

            If n = 1 Then

                Set delrange = area.EntireRow

            Else

                Set delrange = Union(delrange, area.EntireRow)

            End If

        End If

    Next area

    delrange.Delete

End Sub

بانتظار تجارب الإخوة

  • Like 1
قام بنشر

نعم اخي محمد

هذا الكود يعمل بهذه الطريقة بفحص فقط الخلية الاولى و من ثم يقوم بحذف السطر او العمود بناءاً عليها

فهذا ما اقوم انا بعمله في الحياة العملية

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

  • 4 years later...
  • 2 years later...
قام بنشر

بسم الله الرحمن الرحيم

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

بناء على رسالة من أخي الفاضل / محمد طاهر

واعتماد  طريقة جديدة وبسيطة في التفكير بصورة عملية

ربما يفيدكم هذا الملف بإذن الله

وفقنا الله وإياكم لكل ما يحب ويرضى

حذف الصفوف والأ‘عمدة بالكود.rar

  • Like 4
قام بنشر

أخي وحبيبي في الله محمد صالح

أين أنت معلمي ..؟ اشتقنا لوجودك فيما بيننا .. مفتقدينك والله ومفتقدين حلولك الجميلة والرائعة

لعل غيابك عنا خير

تقبل وافر تقديري واحترامي

 

  • Like 2
  • 1 year later...
قام بنشر

ارجو من الاخوه 
   الخبراء استفسار لهذه الاكواد 
 اننا عايز اعمل مدى للحذف يعنى لو عندى اكتر من جدول للحذف يتم حذف الصفوف ف الجدوا الاول بس

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

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