Как да изтрия ред при определени условия?
Здравейте, имам следният казус Таблица с динамичен брой на редовете /средно по 4000/ и 31 колони . Опитвам се да напиша процедура, която да открива нулеви стойности в две конкретни клетки и като ги намери да изтрие реда. Това което направих работи, но много бавно.
Public Sub DeLL_nula()
Dim i As Integer Dim row_last As Long
row_last = Range("C2").CurrentRegion.Rows.Count For i = 2 To row_last If Cells(i, 10) = 0 And Cells(i, 17) = 0 Then
Range(Cells(i, 1), Cells(i, 31)).Delete i = i - 1
End If Next i
End Sub
Имали друг вариант? Благодаря предварително
Sub DelZero() Dim i As Long Dim tOld
tOld = Now DoEvents i = 2
Do If Cells(i, 5) = 0 Then Rows(i).Delete Shift:=xlUp Else i = i + 1 End If Loop While Cells(i, 1) <> "" MsgBox ("Времето за изтриване е :" & Format(Now - tOld, "ss:ms")) End Sub
Това е което аз нещото което мога аз да ти предложа. Като трябва да се има предвид, че i показва началото на таблицата ти с данни. За да работи коректно функцията е необходимо на първата колона задължително да пише нещо. При мен тази функция се изпълнява за 1s и 120ms при над 15 000 реда.
Това е таблицата
Това е времето за изпълнение
Благодаря ти Румен, Свърши работа с малко нагласяне към моите данни. Аз си открих и грешката, просто зацикля накрая. Но твоето решение е много по-добро.
Здравейте, когато се изтриват редове е по-добре изтриването да става от последния към първия ред на таблицата. Например, имате 200 реда в таблицата, в които имате 100 реда, които трябва да се изтрият. Започвате от първия ред, изтривате реда. Определили сте цикъла да се изпълнява 200 пъти, а след изтриването в таблицата вече има 199 реда, т.е. цикъла ще се изпълнява и за вече празни редове, което е причина за бавното изпълнение - 4000 реда! Решението е (използвам кода на Ева):
Public Sub DeLL_nula()
Dim i As Integer Dim row_last As Long
row_last = Range("C2").CurrentRegion.Rows.Count
For i = row_last To 2 Step -1
If Cells(i, 10) = 0 And Cells(i, 17) = 0 Then Range(Cells(i, 1), Cells(i, 31)).Delete
End If
Next i
End Sub
Надявам се, че успях да помогна.
Благодаря Ви за отговора, както и за прекрасния курс. Наистина сега процедурата работи много бързо.
браво
Вашият отговор
