Question

我写了一个简单的宏

=IF(C2=H2,1,))

所以当C2的值等于H2的值时，弹出窗口会显示“HI”

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rng As Range
    Set rng = Range("H2")
    If Not Intersect(Target, rng) Is Nothing Then
        If rng = "1" Then
            MsgBox "Cell " & _
                   rng.Address & " = hi"
        End If
    End If

    Set rng = Nothing
End Sub

问题在于我需要它来制作声音和弹出窗口，更重要的是我需要它来做1000行（即c2，c3，c4以及c1000）。不要告诉我，我需要粘贴和复制一千次。

Answer 1

很难理解你究竟想要完成什么，因为你的问题不是很清楚。如果我理解正确，当在H列中更改值时，您要检查它是否与C列中的相应单元格匹配。如果值匹配，则您希望显示消息框并播放声音。这段代码就是这样做的。如果我误解了目标，请澄清，我会尽我所能帮助。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    On Error Resume Next
    If Target.Column = 8 Then
        If Target.Value = Target.Offset(0, -5).Value Then
            Beep
            MsgBox "Cell " & Target.Address(False, False) & " = Hi"
        End If
    End If
    On Error GoTo 0
End Sub

Answer 2

试试这个

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Range("C2:C1000")) Is Nothing Then
        If Target.Value = Target.Offset(, 5).Value Then
            Beep
            MsgBox "Blah Blah"
        End If
    '~~> Added Code to handle changes in Col H as well. Thanks to ripster
    ElseIf Not Intersect(Target, Range("H2:H1000")) Is Nothing Then
        If Target.Value = Target.Offset(, -5).Value Then
            Beep
            MsgBox "Blah Blah"
        End If
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

我总是建议使用正确的错误处理。您可能还想查看this？

如果存在多个粘贴，则上述代码无法处理该情况。如果你想检查一下，请告诉我:)）

每当单元格值发生变化时，都会弹出一个窗口

2 个答案: