حذف ردیف های یک شیت که بصورت یک سری خاص بعد از هم قرار گرفته اند

[amin.t]

سلام بر دوستان و اساتید عزیز

من یک شیت دارم که یکسری دیتا رو داخلش کپی می کنم و بعضی از ردیفها کارایی ندارند و نیاز هست حذفشون بکنم

ردیفهای بطور متناوب تکرار می شن ، مثلا ردیفهای 3,4,5,7 11,12,13,16 20,21,22,25 29,30,31,34 و .... تا ردیف 1000 همینطور ادامه دارد

حالا چطور میشه با یک کد نویسی این ردیفهای متناوب رو حذف کرد ؟

ممنون می شم راهنمایی بفرمایید

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[iranweld]

با سلام

ماکرو ذیل را تست بفرمایید

Sub Macro1()

K = Cells(Rows.Count, "A").End(xlUp).Row

For i = K To 1 Step -2

    Rows(i & ":" & i).Delete Shift:=xlUp
    
        Next
        
    Range("A1").Select
    
End Sub 

[amin.t]

با سلام

ماکرو ذیل را تست بفرمایید

Sub Macro1()

K = Cells(Rows.Count, "A").End(xlUp).Row

For i = K To 1 Step -2

    Rows(i & ":" & i).Delete Shift:=xlUp
    
        Next
        
    Range("A1").Select
    
End Sub 

سلام
دوست عزیز ممنون از راهنماییتون
ولی میشه اون بخش 1step -2 رو توضیح بدید

[iranweld]

با سلام

در ماکرو فوق از آخرین ردیف شروع به حذف شده و step -2 بدین معنی است که برای حذف ردیف بعدی دو ردیف پرش نمایید. یا بصورت یک در میان حذف نماید

ضمنا یک مشکل در ماکرو بالا وجود داشت که اگر تعداد ردیف ها زوج باشد فقط ردیفهای زوج را حذف مینماید که ماکرو اصلاح گردید

Sub Macro1()

k = Cells(Rows.Count, "A").End(xlUp).Row

For i = k To 1 Step -1


If i Mod 2 > 0 Then

    Rows(i & ":" & i).Delete Shift:=xlUp
    
        
        End If
        
        Next
        
    Range("A1").Select
    
End Sub 

[amin.t]

با سلام

در ماکرو فوق از آخرین ردیف شروع به حذف شده و step -2 بدین معنی است که برای حذف ردیف بعدی دو ردیف پرش نمایید. یا بصورت یک در میان حذف نماید

ضمنا یک مشکل در ماکرو بالا وجود داشت که اگر تعداد ردیف ها زوج باشد فقط ردیفهای زوج را حذف مینماید که ماکرو اصلاح گردید

Sub Macro1()

k = Cells(Rows.Count, "A").End(xlUp).Row

For i = k To 1 Step -1


If i Mod 2 > 0 Then

    Rows(i & ":" & i).Delete Shift:=xlUp
    
        
        End If
        
        Next
        
    Range("A1").Select
    
End Sub 

دوست عزیز واقعا ممنون این لطفتون هستم
همیشه موفق باشید