Excel / VBA Worksheet_Change整个重复
我有一个worksheet_changemacros正在运行。 我想要做的是检查用户从其他工作簿中粘贴符合特定条件的值的时间。 例如，如果最终用户粘贴到标题列的A列（其开始于A18），则其值将被拒绝，除非它们在标题列C下的另一个工作表“下拉菜单”上符合值。等等整个工作表中有几行需要匹配。
现在发生的情况是，如果我在A-E列中发布值，并且A18中的值不是一个有效的标题，那么我会得到A18，B18，C18，D18等单元格中的值必须是有效的“标题”和E18，然后如果E18是不是一个有效的types它回去，并告诉我A18是无效的，我觉得这是一个application.enable = falsetypes的解决scheme，但无法弄清楚。
谢谢
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 谢谢Matt
由于你的validation代码在两次检查之间几乎是相同的，所以我把它放到一个单独的子节点中，并从事件处理程序调用它。
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