Моя петля не закончится

Question

1) У меня есть эмблема с моей петлей FOR. Я иду ad infinitum. И это первая моя проблема, о которой я прошу вашу помощь.
2) Вторая проблема заключается в том, что я не знаю, как добавить более одного условия в «If»
Мои вопросы содержатся в этом коде в виде комментариев.

Sub Repurchase_upload() 

Dim Worksheet As Worksheets 
startrow = Worksheets("GUTS").Cells(10, 1) 'Here I denote 1 
endrow = Worksheets("GUTS").Cells(11, 1) 'Here I denote 1000 
For x = startrow To endrow 

      If Cells(x, "A").Value <> "DU" Then 'I would like it to look like that: 'If Cells(x, "A").Value <> "DU" or "DR" or "EK" Then' but I don't know how to do this 'or' 
      Cells(x, "A").EntireRow.ClearContents 
      End If 'And here it won't end... 
    Next 
End Sub 

Answer 1

Многократное условие легко реализовать:

For x = startrow To endrow 
    If Cells(x, "A").Value <> "DU" Or Cells(x, "A").Value <> "DR" Or Cells(x, "A").Value <> "EK" Then 
     Cells(x, "A").EntireRow.ClearContents 
    End If 
Next x 

Для бесконечного цикла я не знаю, это, кажется, хорошо для меня ... не просто слишком медленно?
Возможно, вам нужно отключить обновление экрана перед вызовом ClearContents тысячу раз, например. :

Sub Repurchase_upload() 

    Application.ScreenUpdating = False 'Disable screen updating 

    Dim Worksheet As Worksheets 
    startrow = Worksheets("GUTS").Cells(10, 1) 'Here I denote 1 
    endrow = Worksheets("GUTS").Cells(11, 1) 'Here I denote 1000 
    For x = startrow To endrow 
     If Cells(x, "A").Value <> "DU" Or Cells(x, "A").Value <> "DR" Or Cells(x, "A").Value <> "EK" Then 
      Cells(x, "A").EntireRow.ClearContents 
     End If 
    Next x 

    Application.ScreenUpdating = True 'Re-enable screen updating 

End Sub 

Answer 2

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

Sub Repurchase_upload() 

    Dim Worksheet As Worksheets 
    startrow = Worksheets("GUTS").Cells(10, 1) 'Here I denote 1 
    endrow = Worksheets("GUTS").Cells(11, 1) 'Here I denote 1000 
    For x = startrow To endrow 
     Select Case Cells(x, "A").Value 
     Case "DU", "DR", "EK" 
      'Do nothing 
     Case Else 
      Cells(x, "A").EntireRow.ClearContents 
     End Select 
    Next 
End Sub