[حل شده] حذف محتوی تعداد کمی از سلول ها در لیست دارای 5000 سلول

[e2a1385]

با سلام
من یه جدول دارم که دارای 5000 سلول هستش و در هربار استفاده حدودا 60 سلول این جدول به صورت تصادفی دارای اطلاعات خواهد بود. برای پاک کردن محتوی فقط این سلولها روشی وجود داره
به عنوان مثال در فایل پیوست سلولهای دارای عدد 1 فقط محتواش حذف بشه و بقیه سلولها اساسا چک نشه چون با توجه به تعداد سلولها زمان زیادی صرف میشه
خیلی ممنون

[iranweld]

با سلام

فایل پیوست را تست کنید

در فایل اصلی محدوده مورد نظر را اصلاح کنید Range("C2:K14")

Sub Macro3()

    
    Range("C2:K14").Replace What:="1", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub 

[e2a1385]

خیلی ممنون
در فایل اصلی سرعت همچنان پایینه
میخواستم اگه روشی موجوده فقط آدرس سلولهای دارای دیتا چک بشه
دیتای سلول میتونه اعداد دیگه غیر از 1 هم باشه
در مجموع ممنون از لطفتون

[M_ExceL]

خیلی ممنون
در فایل اصلی سرعت همچنان پایینه
میخواستم اگه روشی موجوده فقط آدرس سلولهای دارای دیتا چک بشه
دیتای سلول میتونه اعداد دیگه غیر از 1 هم باشه
در مجموع ممنون از لطفتون

سلام،
چه تعداد ردیف و ستون دارید؟
فکر نمیکنم مشکلی باشه کدی که دوستمان جناب iranweld قرار دادند در کسری از ثانیه انجام می دهد.
اگر می خواهید فقط سلول های دارای عدد چک شوند کد زیر رو استفاده کنید.

[SIZE=3]
 Sub m_excel()

    Dim cel, rng As Range
    Dim lstr, lstc As Long
        
        lstr = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Row
        lstc = Cells.Find("*", Cells(1, 1), , , xlByColumns, xlPrevious).Column
        Set rng = Range(Cells(2, 3), Cells(lstr, lstc)).SpecialCells(xlCellTypeConstants, 1)
        
                Application.ScreenUpdating = False
                
                        For Each cel In rng
                            If cel.Value = "1" Then
                                cel.Value = Empty
                            End If
                        Next
                    
                Application.ScreenUpdating = True
            
End Sub[/SIZE]

یا کد زیر :

Sub m_excel()

    Dim rng As Range
    Dim lstr, lstc As Long
        
        lstr = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Row
        lstc = Cells.Find("*", Cells(1, 1), , , xlByColumns, xlPrevious).Column
        Set rng = Range(Cells(2, 3), Cells(lstr, lstc)).SpecialCells(xlCellTypeConstants, 1)
        
        Application.ScreenUpdating = False
             rng.Replace What:="1", Replacement:=Empty, LookAt:=xlWhole, MatchCase:=True
        Application.ScreenUpdating = True
            
End Sub

[e2a1385]

این روش ساده به ذهنم رسید
در دستوراتی که دوستان گفتند کل رنج بررسی می شد که با توجه به تعداد سلولهای پروژه من سرعتش پایین بود

با این دستورات در رنج a1 تا g10 هر سلولی را انتخاب کنید آدرسش در ستون h ذخیره می شود

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim last_row

last_row = Sheets("Sheet1").Range("H1").End(xlDown).Row + 1

If Not Intersect(Target, Range("A1:G10")) Is Nothing Then

Cells(last_row, 8) = Target.Address

End If

End Sub با این ماکرو فقط سلولهایی که آدرس اونها در ستون h قرار دارند محتواش پاک میشه Sub Clear() Dim N As Integer Dim myRange As Range Set myRange = Sheets("Sheet1").Range("A1:G10") N = WorksheetFunction.CountA(myRange) + 2 For i = 3 To N Range(Cells(i, 8).Value).ClearContents Next i Range("H3:H100").ClearContents End Sub