vba - 比较单元格值以激活 Msgbox

Question

有宏观问题。 VBA初学者。有以下情况:

Column D    Column E
3           2

我只是想确保用户没有在 D 列中输入任何超过 E 列的内容。如果是这样，则会弹出一个消息框并告诉用户问题。

下面的代码适用于单元格 D4/E4，但如果我想将 D5 与 E5、D6 与 E6 等进行比较，则无法使其适用于以后的每个单元格。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("D4") > Range("E4") Then
        MsgBox "Discount too high"
    End If
End Sub

Answer 1

请务必使用 Target目的。它代表更改的单元格

检查 Target位于 D 列中

循环通过 Target粘贴到/更新多个单元格时避免错误的单元格

使用Offset到达列 E

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, s As String
    If Intersect(Target, Range("D:E")) Is Nothing Then Exit Sub
    For Each r In Target
        If Intersect(Range("D:D"), r.EntireRow).Value > Intersect(Range("E:E"), r.EntireRow).Value And Intersect(Range("E:E"), r.EntireRow) <> vbNullString Then s = s & ", " & r.Address
    Next r
    If s <> vbNullString Then MsgBox "Discount too high in cells: " & Mid(s, 3)
End Sub

“相同”单元格的更新

这也将捕获具有相同折扣率的单元格

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, d As Range, e As Range
    Dim high As String, same As String, s As String

    If Intersect(Target, Range("D:E")) Is Nothing Then Exit Sub
    For Each r In Target
        Set d = Intersect(Range("D:D"), r.EntireRow)
        Set e = Intersect(Range("E:E"), r.EntireRow)
        If d.Value > e.Value And e.Value <> vbNullString Then high = high & ", " & r.Address
        If d.Value = e.Value And e.Value <> vbNullString Then same = same & ", " & r.Address
    Next r
    If high <> vbNullString Then s = "Discount too high in cells: " & Mid(high, 3)
    If same <> vbNullString Then
        If s <> vbNullString Then s = s & vbCrLf
        s = s & "Discount the same in cells: " & Mid(same, 3)
    End If

    If s <> vbNullString Then MsgBox s, vbOKOnly, "Error"
End Sub