Question

我有一个workheet_change宏正在运行。我想要它做的是检查用户粘贴来自另一个工作簿的值是否符合特定条件。例如，如果最终用户粘贴到列A（从A18开始）（即标题列），则他的值将被拒绝，除非它们满足另一个工作表上的值＆＃34; Drop Down Menus＆＃34;在标题栏C等下。整个工作表中有几行需要匹配。

现在发生的事情是，如果我在A - E列中发布值，并且A18中的值不是有效的标题，我会收到消息框＆＃34;单元格中的值必须是有效的＆＃34;标题＆＃ 34;对于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

Excel / VBA工作表_改变整个过程

1 个答案: