Действуйте слишком долго

Question

Я использую этот код

For lrow = Lastrow To Firstrow Step -1 
Set workrange = Cells(lrow, 5) 
Set workrange2 = Cells(lrow, 10) 
If workrange.Value = "100" _ 
And workrange2.Value = "0" _ 
     Then workrange.EntireRow.Delete 
Next lrow 
For lrow = Lastrow To Firstrow Step -1 
Set workrange = Cells(lrow, 5) 
Set workrange2 = Cells(lrow, 10) 
If workrange.Value = "105" _ 
And workrange2.Value = "0" _ 
     Then workrange.EntireRow.Delete 
Next lrow 
For lrow = Lastrow To Firstrow Step -1 
Set workrange = Cells(lrow, 5) 
Set workrange2 = Cells(lrow, 10) 
If workrange.Value = "113" _ 
And workrange2.Value = "0" _ 
     Then workrange.EntireRow.Delete 
Next lrow 
For lrow = Lastrow To Firstrow Step -1 
Set workrange = Cells(lrow, 5) 
Set workrange2 = Cells(lrow, 10) 
If workrange.Value = "120" _ 
And workrange2.Value = "0" _ 
     Then workrange.EntireRow.Delete 
Next lrow 
For lrow = Lastrow To Firstrow Step -1 
Set workrange = Cells(lrow, 5) 
Set workrange2 = Cells(lrow, 10) 
If workrange.Value = "123" _ 
And workrange2.Value = "0" _ 
     Then workrange.EntireRow.Delete 
Next lrow 
For lrow = Lastrow To Firstrow Step -1 
Set workrange = Cells(lrow, 5) 
Set workrange2 = Cells(lrow, 10) 
If workrange.Value = "124" _ 
And workrange2.Value = "0" _ 
     Then workrange.EntireRow.Delete 
Next lrow 
For lrow = Lastrow To Firstrow Step -1 
Set workrange = Cells(lrow, 5) 
Set workrange2 = Cells(lrow, 10) 
If workrange.Value = "125" _ 
And workrange2.Value = "0" _ 
     Then workrange.EntireRow.Delete 
Next lrow 

Я получаю процедуру слишком долго, потому что у меня есть это тот же код, но и для множества других значений для workrange.value части кода. Есть ли способ потоковой передачи этого кода, так что любое значение, которое я хочу для workrange.value, может соответствовать ему без наличия массивных строк кода? Благодаря!

Answer 1

Чтобы решить эту проблему с использованием петель, сначала имейте в виду, что вы хотите как можно больше ограничить количество циклов - цикл без необходимости потребует дополнительного вычислительного времени. Вообще говоря, мы создадим конкретный «массив» значений, который содержит весь список всех чисел, с которыми вы хотите сопоставить. Мы создадим цикл, который проверяет, соответствует ли значение любому из значений массива, но прежде чем мы сделаем этот цикл, мы сначала проверим, есть ли другое значение 0.

Я не мог видеть шаблон, который был после чего вы определяете, какие значения вы заботитесь, поэтому я показал, как вы вручную вставляете каждое значение в массив. Если там какой-то образец там я не видел, это можно сделать по-другому. В качестве альтернативы, если у вас уже есть эти цифры в Excel, вы можете сделать эту строку/столбец Excel именованным диапазоном, а затем пропустить это, не создавая собственный массив.

Edited ниже, чтобы выйти из цикла For, если она попадает матч, чтобы предотвратить попытки проверить значение строки, которая была удалена

Dim CheckArray() As Integer 
Dim CheckArraySize As Integer 
Dim ArrayCounter As Integer 

CheckArraySize = 7 
ReDim CheckArray(1, CheckArraySize) 

CheckArray(1) = "100" 'Note that these are TEXT values, not numbers, 
CheckArray(2) = "105" 'Per the examples in the OP 
CheckArray(3) = "113" 
CheckArray(4) = "120" 
CheckArray(5) = "123" 
CheckArray(6) = "124" 
CheckArray(7) = "125" 


For lrow = Lastrow To Firstrow Step -1 
    Set workrange = Cells(lrow, 5) 
    Set workrange2 = Cells(lrow, 10) 
    If workrange2.Value = "0" Then 
     For ArrayCounter = 1 To CheckArraySize 
      If workrange.Value = CheckArray(ArrayCounter) Then 
       workrange.EntireRow.Delete 
       ArrayCounter = CheckArraySize 
      End If 
     Next ArrayCounter 
    End If 
Next lrow 

Альтернативный подход предложен в комментариях @xidgel - будет работать быстрее

Dim CheckArray() As Integer 
Dim CheckArraySize As Integer 
Dim ArrayCounter As Integer 
Dim CheckString as String 

CheckArraySize = 7 
ReDim CheckArray(1, CheckArraySize) 

CheckArray(1) = "100" 'Note that these are TEXT values, not numbers, 
CheckArray(2) = "105" 'Per the examples in the OP 
CheckArray(3) = "113" 
CheckArray(4) = "120" 
CheckArray(5) = "123" 
CheckArray(6) = "124" 
CheckArray(7) = "125" 

For ArrayCounter = 1 to CheckArraySize 
    CheckString = CheckString & CheckArray(ArrayCounter) &":" 
Next ArrayCounter 'This loops to create a single string which contains all values that you want to check against 

For lrow = Lastrow To Firstrow Step -1 
    Set workrange = Cells(lrow, 5) 
    Set workrange2 = Cells(lrow, 10) 
    If workrange2.Value = "0" Then 
     If InStr(1, CheckString, workrange.Value) > 0 Then 'checks if workrange is found in the compilation of all array values 
      workrange.EntireRow.Delete 
     End If 
    End If 
Next lrow 

2nd EDIT, чтобы отразить тот факт, что «условия поиска» уже находятся в Excel

Этот метод работает в основном так же, как и выше, за исключением того, что вместо определения нового массива вы просто вызываете массив из Excel, где он уже хранится. Вы говорите, что «поисковые термины» уже находятся в другой книге. Я предполагаю, что они находятся в одном столбце. Скопируйте этот столбец в текущую книгу, скажем, в sheet2! column A. Выберите все эти записи; перейдите на ленту формул -> Диспетчер имен -> Новое имя. Назовите это новое имя CheckArray. Чтобы ссылаться на это новое имя в VBA, вы можете просто вызвать листы (2) .Range («CheckArray»). Все остальное будет в основном идентичны выше, только с начала присвоения изменения CheckString, как и [также удалить Dim CheckArray() заявление»]:

CheckArraySize = Sheets(2).Range("CheckArray").Rows.Count 

For ArrayCounter = 1 to CheckArraySize 
    CheckString = CheckString & Sheets(2).Range("CheckArray")(ArrayCounter,1) &":" 
Next ArrayCounter 

Кроме как вы тянете строковые значения в ваша контрольная строка, остальная часть кода будет одинаковой.