Excel/VBA Worksheet_Change 自始至终重复

Question

我有一个 worksheet_change 宏正在运行。我想要它做的是检查用户何时从另一个工作簿粘贴符合某些条件的值。例如，如果最终用户粘贴到作为标题列的 A 列（从 A18 开始），则他的值将被拒绝，除非它们符合标题列 C 下另一个工作表“下拉菜单”中的值。等等。是整个工作表中需要匹配的几行。

现在发生的情况是，如果我在 A - E 列中发布值，并且 A18 中的值不是有效的标题，我会收到消息框“单元格中的值必须是 A18、B18、C18 的有效“标题” , D18, 和 E18，然后如果 E18 不是有效类型，它会返回并告诉我 A18 也无效。我觉得这是一个 application.enable = false 类型的解决方案，但无法弄清楚。

谢谢

Private Sub Worksheet_Change(ByVal Target As Range)
'Insures values in column A are from Title List
    Dim Title As Range
    Set Title = Worksheets("DATA INPUT SHEET").Range("A18:A100000")
    If Not Intersect(Target, Title) Is Nothing Then
'
        For Each c In Target
            Set TitleLst = Worksheets("DROP DOWN MENUS").Range("C2:C1000").Find(c.Value, lookat:=xlWhole, LookIn:=xlValues, MatchCase:=False)
            If TitleLst Is Nothing And c <> "" Then
                 Application.EnableEvents = False
                MsgBox "The value at " & c.Address(False, False) & " must be a valid " & Worksheets("DROP DOWN MENUS").Range("C1"), vbOKOnly + vbCritical
                c.ClearContents
                Application.EnableEvents = True
            End If
        Next
    End If
 'Insures values in column E are from Recipient List
    Dim Recipient As Range
    Set Recipient = Worksheets("DATA INPUT SHEET").Range("E18:E100000")
    If Not Intersect(Target, Recipient) Is Nothing Then
        For Each c In Target
            Set RecipientLst = Worksheets("DROP DOWN MENUS").Range("D2:D1000").Find(c.Value, lookat:=xlWhole, LookIn:=xlValues, MatchCase:=False)
            If RecipientLst Is Nothing And c <> "" Then
                MsgBox "The value at " & c.Address(False, False) & " must be a valid " & Worksheets("DROP DOWN MENUS").Range("D1"), vbOKOnly + vbCritical
                c.ClearContents
            End If
        Next
    End If
End Sub

谢谢 马特

Answer 1

由于您的验证代码在两次检查之间几乎相同，因此我会将其放入单独的子程序中并从事件处理程序中调用它。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim ShtDDM As Worksheet

    Set ShtDDM = Worksheets("DROP DOWN MENUS")

    'in a worksheet module you can use "Me" to refer to the worksheet
    ValidateValues Application.Intersect(Me.Range("A18:A100000"), Target), _
                   ShtDDM.Range("C2:C1000"), _
                   ShtDDM.Range("C1")

    ValidateValues Application.Intersect(Me.Range("E18:E100000"), Target), _
                   ShtDDM.Range("D2:D1000"), _
                   ShtDDM.Range("D1")

End Sub

Sub ValidateValues(rngInput As Range, rngLookup As Range, sType As String)
    Dim c As Range, f As Range, isect As Range
    If Not rngInput Is Nothing Then
        For Each c In rngInput.Cells
            If Len(c.Value) > 0 Then
                Set f = rngLookup.Find(c.Value, lookat:=xlWhole, LookIn:=xlValues, _
                                                                   MatchCase:=False)
                If f Is Nothing Then
                    Application.EnableEvents = False
                    MsgBox "The value at " & c.Address(False, False) & _
                            " must be a valid " & sType, vbOKOnly + vbCritical
                    c.ClearContents
                    Application.EnableEvents = True
                End If
            End If     'has a value
        Next c
    End If             'any intersect?
End Sub