Question

我有一个用于数据输入的工作表，一种用于规划工作的沙箱工具。因此，随着工作的计划和计划的重新设计和优化，数据集会不断增长和缩小。用户经常输入任务列表，然后重新排序列表，在列表中间插入任务，我需要添加一些验证来解释这些移动。我的解决方案是在列的第一个单元格中设置数据验证，并在每次添加行时仅将验证复制并粘贴到数据集中。

我正在尝试使用数据验证来强制相同的任务具有相同的持续时间。当我手动输入数据验证时，它可以工作，我已经录制了一个宏来仔细检查我的代码。我也尝试用定义为字符串的变量替换公式。但我无法让VBA分配数据验证。

当其中一些动作发生时，我正在调用以下Sub。但是我在.Add行上得到运行时错误1004。不喜欢公式或其中一个参数。

Sub Validate_Dur()

        Dim Last_Row As Long


        Last_Row = Sheets("Template").Cells(Rows.Count, 2).End(xlUp).Row ' catches the new last row
        Range("D3").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateCustom, _ ' this is where I'm having trouble
        AlertStyle:=xlValidAlertStop, _
        Formula1:="=AND(B3=B2,D3=D2)"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Duration Error"
        .InputMessage = ""
        .ErrorMessage = _
        "Tasks with identical descriptions must have the same duration."
        .ShowInput = True
        .ShowError = True
    End With
    Selection.Copy
    Range("D3" & Last_Row).Select
    Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

有任何帮助吗？

Answer 1

您的代码存在一些问题（除了您的问题专门解决的问题之外）。

1）虽然这会将数据验证规则应用于 a 单元格，但正如所写的那样，它不会将其应用于您想要的单元格（＆＃34; D3＆＃34;＆amp; Last_Row ）会将Last_Row的值附加到＆＃34; D3＆＃34;，所以如果Last_Row为6，则会将验证粘贴到＆＃34; D36＆＃34;而不是范围＆＃34; D3：D6＆＃34 ;我认为是你的意图。

2）在纠正第一个问题之后，您仍然会遇到这样一个事实：任何已经存在且不符合这些条件的条目都不会立即被标记。只有当有人试图将持续时间更改为无效条目时，他们才会收到通知消息框。

3）您所写的数据验证规则还会阻止用户在 NOT 相同的情况下输入与上述行不同的持续时间。您可以通过应用该验证规则，然后单击＆＃34;圈无效数据＆＃34;来看到这一点。

现在，假设您可以自己克服问题2和3，这是一个适用于我的系统的简化版本（Win7，Excel 2010-32bit）：

Sub Validate_Dur()

Dim Last_Row As Long
Dim rngToValidate As Range

Set rngToValidate = ActiveSheet.UsedRange.Columns(4)
Set rngToValidate = rngToValidate.Offset(1, 0).Resize(rngToValidate.Rows.Count - 1)

With rngToValidate.Validation
    .Delete
    .Add xlValidateCustom, xlValidAlertStop, , "=AND(B2=B1,D2=D1)"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = "Duration Error"
    .InputMessage = ""
    .ErrorMessage = _
    "Tasks with identical descriptions must have the same duration."
    .ShowInput = True
    .ShowError = True
End With
ActiveSheet.CircleInvalid
End Sub

Excel 2010 VBA分配的数据验证失败

1 个答案: