إختصار كود

[توكل]

إخوتي الأكارم:

بداية كل عام وأنتم بألف خير، أعاده الله علينا وعليكم بالخير واليمن والبركات

في بعض الملفات التي أعمل عليها يكون لدي أسطر كثيرة فارغة أو بها القيمة 0 وقد قمت بكتابة الكود التالي لتنظيف الملف من الأسطر الفارغة والتي تحتوي القيمة صفر ولكن ونظراً لأن الملف كبير جداً فإن العملية تستغرق عدة دقائق فهل يمكن أن يكون هناك كود أقصر وأفضل من الذي قمت بكتابته مع جزيل الشكر مسبقاً

Sub Find0()
'
' Find0 Macro
' Macro recorded 20/02/2003 by abdulhamid
'
' Keyboard Shortcut: Ctrl+Shift+S
'
  '  Selection.SpecialCells(xlCellTypeLastCell).Select
    Selection.EntireColumn.Select
    On Error Resume Next
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    ActiveCell.End(xlDown).Select
    ActiveCell.Next(r + 2, C).Select
    ActiveCell.FormulaR1C1 = "#"
    ActiveCell.End(xlUp).Select
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
    Do
    If ActiveCell.Value = "0" Then
    Selection.EntireRow.Delete
    Else
    If ActiveCell.Value <> 0 Then
    ActiveCell.Next(r + 2, C).Select
    Else
    End If
    End If
    Loop Until ActiveCell.Value = ("#")
    ActiveCell.Delete
   Range("A1").Select
End Sub

[ابو اسامة العينبوسي]

السلام عليكم

لحذف الصفوف الفارغه من نطاق(TT)به 4000 صف

13_12_2008_10_16.rar

[ابو اسامة العينبوسي]

للامرين معا

Private Sub CommandButton1_Click()
Dim cell As Range
Application.ScreenUpdating = False
Range("TT").EntireRow.Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For Each cell In Range("TT")
If cell.Value = 0 Then cell.EntireRow.Delete (xlUp)
Next cell
Application.ScreenUpdating = True
End Sub

[توكل]

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