Выделите несогласованные записи в одном динамическом столбце и настоящем msgbox для всего диапазона

Question

Я новичок здесь и относительно новичок в VBA, поэтому, пожалуйста, несите меня. Я оглянулся, чтобы ответить на это, но ничего не мог найти, поэтому прошу прощения, если об этом уже ответили в другом месте, и я не нашел его.

Я хочу выполнить поиск по указанному столбцу динамической длины и заменить демографию на систему чисел (код замены ниже работает отлично, но если у вас есть предложения, связанные с эффективностью, обязательно!). Тогда я хочу, чтобы выделить любые записи, которые не соответствуют номерам, - это строки, в которых говорилось бы, например, «Менеджер» вместо «Босс» или что-то в этом роде, и появлялось окно с сообщением пользователь вручную закодирует в выделенных полях.

В настоящее время происходит то, что у меня есть условное форматирование для любых записей, которые не совпадают, поэтому они выделяются. Моя «для каждой ячейки» заполняет окно сообщения для каждой отдельной записи, которую он находит, но я просто хочу, чтобы в одном поле было поле для всего диапазона. Было бы лучше выделить несогласованные записи через VBA? Как? Как я могу это кодировать, чтобы предоставить только один ящик для всего диапазона?

Заранее благодарю за помощь!

Sub ReplaceRaterDemographicCodes() 
'Find and replace demographics with their corresponding codes. 
Columns("H:H").Select 
    With Selection 
     .Replace What:="Self", Replacement:="78" 
     .Replace What:="Boss", Replacement:="74" 
     .Replace What:="Boss 1", Replacement:="74" 
     .Replace What:="Peer", Replacement:="75" 
     .Replace What:="Direct Report", Replacement:="76" 
     .Replace What:="Customer", Replacement:="77" 
     .Replace What:="Other", Replacement:="79" 
     .Replace What:="Boss 2", Replacement:="72" 
     .Replace What:="Boss 3", Replacement:="73" 
    End With 
    For Each Cell In Range("H2:H" & Range("H" & Rows.Count).End(xlUp).Row).Select 
     If Not Cell.Value = 72 And Not Cell.Value = 73 And _ 
     Not Cell.Value = 74 And Not Cell.Value = 75 And Not Cell.Value = 76 And _ 
     Not Cell.Value = 77 And Not Cell.Value = 78 And Not Cell.Value = 79 And _ 
     Not Cell.Value = "" Then 
      MsgBox ("There are uncommon demographics listed. Please modify as needed.") 
     End If 
    Next Cell 
End Sub 

Answer 1

Так как вы на самом деле не нужно перебрать все - только пока вы не знаете, что вы хотите, чтобы показать окно сообщения, вы можете просто выйти для цикла после показа окна сообщений:

Sub ReplaceRaterDemographicCodes() 
... 

For Each Cell In Range("H2:H" & Range("H" & Rows.Count).End(xlUp).Row).Select 
    If Not Cell.Value = 72 And Not Cell.Value = 73 And _ 
    Not Cell.Value = 74 And Not Cell.Value = 75 And Not Cell.Value = 76 And _ 
    Not Cell.Value = 77 And Not Cell.Value = 78 And Not Cell.Value = 79 And _ 
    Not Cell.Value = "" Then 
     MsgBox ("There are uncommon demographics listed. Please modify as needed.") 
     Exit For 
    End If 
Next Cell 
End Sub 

Таким образом, окно сообщения отображается только один раз и только в том случае, если оно соответствует вашим критериям.

Answer 2

В связи с @jgridley вот ответ, который включает в себя MsgBox для «Все ясно!». Также удаляется .Select в конце строки For Each (поскольку это вызвало ошибки). Ячейки, выделенные красным цветом, выполняются с помощью Условного форматирования.

Sub ReplaceRaterDemographicCodes() 

Dim bAllClear As Boolean 
bAllClear = True 

... 

For Each Cell In Range("H2:H" & Range("H" & Rows.Count).End(xlUp).Row) 
    If Not Cell.Value = 72 And Not Cell.Value = 73 And _ 
    Not Cell.Value = 74 And Not Cell.Value = 75 And Not Cell.Value = 76 And _ 
    Not Cell.Value = 77 And Not Cell.Value = 78 And Not Cell.Value = 79 And _ 
    Not Cell.Value = "" Then 
     bAllClear = False 
Exit For 
End If 
Next Cell 

If bAllClear = True Then 
    MsgBox ("All clear!") 
    Else 
    MsgBox ("There are uncommon demographics listed." & vbNewLine & _ 
     vbNewLine & "Please modify the cells highlighted in red.") 
End If 
End Sub