0

我是新来的，对 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
4

2 回答 2

0

与@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
于 2013-12-09T16:19:16.780 回答
0

由于您实际上并不需要遍历所有内容 - 直到您知道要显示消息框，您可以在显示消息框后退出 for 循环：

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

这样，消息框仅在符合您的条件时才显示一次。

于 2013-12-03T20:09:36.473 回答