Macro для проверки диапазона ячеек для определенного значения, чтобы скрыть строки, если какие-либо ячейки в диапазоне содержат это значение?

Question

Ниже приведен код, который я до сих пор:

Sub Compare() 

Sheets("SCR SYSTEM SPECS").Select 
Sheets("SCR SYSTEM SPECS").Copy 
Dim WS As Excel.Worksheet 
Dim ColumnCount As Long 
Dim I As Long 
Dim Cell As Excel.Range 

Set WS = ActiveSheet 'adjust as necessary 
ColumnCount = 12 'adjust as necessary 
With WS 
For I = ColumnCount To 1 Step -1 
    Set Cell = .Cells(3, I) 
    If Cell.Value = False Then 
     Cell.EntireColumn.Delete 
    End If 
Next I 
End With 

ActiveSheet.Shapes.Range(Array("Button 1", "Check Box 1", "Check Box 2", _ 
    "Check Box 3", "Check Box 4", "Check Box 5", "Check Box 6", "Check Box 7", _ 
    "Check Box 8", "Check Box 9", "Check Box 10", "Check Box 11")).Select 
Selection.Delete 

End Sub 

Что мне нужно, это макрос, чтобы пойти ниже все это перебрать диапазон B4: L4 и проверить каждую ячейку, чтобы увидеть, заканчивается ли она с X или не. Эта строка будет содержать любую комбинацию следующих чисел/текста: 1300, 2000, 2000X, 2500, 2500X, 3000, 3000X, 4500, 6000, 7000, 9000. Мне нужно сказать, что если ни одна из этих ячеек не закончится в X, тогда скройте или удалите определенные строки. Я пытаюсь использовать, если не нравится «* X», безуспешно. Ниже приведен код, который я пробовал до сих пор, который не увенчался успехом. Буду признателен за любую оказанную помощь.

Dim MyCell, Rng As Range 
Set Rng = Sheets("SCR SYSTEM SPECS").Range("B4:L4") 
For Each MyCell In Rng 
    If Not MyCell Like "*X" Then '''''will only do something if the cell is not blank 
    Rows("4:18").Select 
    Selection.EntireRow.Hidden = True 
    'Else '''''if cell is equal to blank 
    'Rows("4:18").Select 
    'Selection.EntireRow.Hidden = False 
    End If 
Next 

Это измененное код, который я пытаюсь использовать, чтобы скрыть строки, которые содержат все 0, но он скрывает строки, содержат ли они все 0 или если они содержат 2 колонки с 0, то в колонке с 4 . Пожалуйста, порекомендуйте.

Dim MyCell2, Rng2 As Range 
Set Rng2 = Sheets("SCR SYSTEM SPECS").Range("B36:L36") 
For Each MyCell2 In Rng2 
    If Right(Trim(MyCell2.Value), 1) = "0" Then 
    Range("36:36").Select 
    Selection.EntireRow.Hidden = True 
    End If 
Next 

Answer 1

LIKE функция является сложной, и, вероятно, не то, что вы хотите, так как это нечеткая, в любом случае.

Используйте RIGHT функцию:

Sub TestThis() 
Dim MyCell, Rng As Range 
Set Rng = Sheets("SCR SYSTEM SPECS").Range("B4:L4") 
For Each MyCell In Rng 
    If Right(Trim(MyCell.Value),1) = "X" Then '''''will only do something if the cell is not blank 
     Rows("4:18").EntireRow.Hidden = True 
     'Else '''''if cell is equal to blank 
     'Rows("4:18").EntireRow.Hidden = False 
    End If 
Next 
End Sub 

Я также пересмотреть код выше, чтобы избежать Selection, который является ненужным около 99% времени.

Потому что вы ищете «Если NONE из этих ячеек содержат ...» Я предлагаю следующую дополнительную ревизию: Exit цикл после выполнения условия.

Sub TestThis() 
Dim MyCell, Rng As Range 
Set Rng = Sheets("SCR SYSTEM SPECS").Range("B4:L4") 
For Each MyCell In Rng 
    If Right(Trim(MyCell.Value),1) = "X" Then '''''will only do something if the cell is not blank 
     Rows("4:18").EntireRow.Hidden = True 
     Exit For '## Exit the loop once the condition is met ##' 
     'Else '''''if cell is equal to blank 
     'Rows("4:18").EntireRow.Hidden = False 
    End If 
Next 
End Sub