将单元格数据验证设置为动态范围列表

时间:2013-07-10 03:14:00

标签: excel vba

我正在尝试使用VBA宏从我的工作表中存储的列表中设置单元格数据验证。我不知道列表将持续多长时间,因此需要动态选择范围。

此时行.Add Type:= Formula1:=“= perfGradeRange”正在抛出运行时错误'1004'应用程序定义或对象定义错误。

我的代码是:

Sub Perf_Grade_Dropdown()

Dim perfGradeData As Worksheet
Dim usedRange As range
Dim rLastCell As range
Dim range As range
Dim perfGradeRange As range

Set perfGradeData = Worksheets("Values")

perfGradeData.Unprotect Password:="pass"

perfGradeData.Activate

Set rLastCell = perfGradeData.Cells.Find(What:="*", After:=Cells(1, 1),    LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)

Set perfGradeRange = perfGradeData.range(Cells(1, 1), rLastCell)

Set range = perfGradeData.range(Cells(3, 3), Cells(4, 3))

    With range.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="=perfGradeRange"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

perfGradeData.Protect Password:="pass", DrawingObjects:=True, contents:=True,          Scenarios:=True, userinterfaceonly:=True, _
AllowSorting:=True, AllowFiltering:=True, AllowDeletingColumns:=True,    AllowInsertingColumns:=True
perfGradeData.EnableAutoFilter = True

 End Sub

我已经看到已经提出以下两个问题,但未能得到任何建议:

Setting validation via VBA in excel fails when using variable

How do I avoid run-time error when a worksheet is protected in MS-Excel?

感谢任何帮助。

1 个答案:

答案 0 :(得分:3)

Range是一个类,所以最好不要将它用于变量名。其次,Formula1:=需要参数作为字符串,所以我使用了perfGradeRange.Cells(1)

Sub Perf_Grade_Dropdown()

        Dim perfGradeData As Worksheet
        Dim usedRange As range
        Dim rLastCell As range
        Dim rng As range
        Dim perfGradeRange As range

        Set perfGradeData = Worksheets("Values")

        perfGradeData.Unprotect Password:="pass"

        perfGradeData.Activate

        Set rLastCell = perfGradeData.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                                                 xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)

        Set perfGradeRange = perfGradeData.range(Cells(1, 1), rLastCell)

        Set rng = perfGradeData.range(Cells(3, 3), Cells(4, 3))

        With rng.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=perfGradeRange.Cells(1)
            .IgnoreBlank = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With


        perfGradeData.Protect Password:="pass", DrawingObjects:=True, contents:=True, Scenarios:=True, userinterfaceonly:=True, _
                              AllowSorting:=True, AllowFiltering:=True, AllowDeletingColumns:=True, AllowInsertingColumns:=True
        perfGradeData.EnableAutoFilter = True

    End Sub