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

[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



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