创建多个数据验证列表而不参考相同范围EXCEL VBA

时间:2011-07-28 19:11:52

标签: excel list vba drop-down-menu named-ranges

我正在excel VBA中编写一个宏,它在指定的单元格中创建数据验证列表。然后程序提示用户输入包含数据验证列表内容的单元格。然后,从视图中隐藏包含列表内容的相同行。但是,当我尝试多次重新运行宏时,每次为内容选择一个新范围时,每个进程列表都会引用此范围。 我不希望希望这种情况发生。

我写了这行代码来防止这种情况:

For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNmLbl + 1
Next nm
strRange = strRange & strRngNumLbl

其中strRng是添加到数据验证时要引用的范围的名称。但是,由于某种原因,这不起作用。我认为这样可行,因为它会为要添加到列表的每个范围创建独立的名称。但它没有......

以下是整个代码:

Sub CreatDropDownList()
Dim strRange As String
Dim celNm As Range
Dim celNm2 As Range 'use only if necessary
Dim celRng As Range
Dim strRngNumLbl As Integer
Dim nm As Name


On Error GoTo pressedCancel:

Set celNm = Application.InputBox(Prompt:= _
                "Please select a cell to create a list.", _
                   Title:="SPECIFY Cell", Type:=8)

If celNm Is Nothing Then Exit Sub

'Inserts a copy of the row where the drop down list is going to be
celNm.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.Insert '?


'moves the cell to the appropriate location
celNm.Offset(0, -1).Value = "N/A"

'cell range equal to nothing
Set celRng = Nothing

'asks user to determine range of strings
Set celRng = Application.InputBox(Prompt:= _
    "Please select the range of cells to be included in list.", _
        Title:="SPECIFY RANGE", Type:=8)

If celRng Is Nothing Then Exit Sub
On Error GoTo 0

strRange = "DataRange"
strRngNumLbl = 1

'Increments strRngNumLblb for the number of names present in the workbook to
'ensure list is not referring to duplicate ranges
For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNmLbl + 1
Next nm
strRange = strRange & strRngNumLbl

'user defined data range is now called strRange, refer to it as Range(strRange)
ThisWorkbook.Names.Add Name:=strRange, RefersTo:=celRng

'format the refernce name for use in Validation.add
strRange = "=" & strRange

celNm.Offset(-1, 0).Select

'Add the drop down list to the target range using the list range
celNm.Validation.Delete
celNm.Validation.Add xlValidateList, , , strRange

'hide the range where the list came from
celRng.EntireRow.Hidden = True

pressedCancel:
End Sub

有什么建议吗?

2 个答案:

答案 0 :(得分:1)

解决您的问题

而不是:

For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNmLbl + 1
Next nm

你应该:

strRngNumLbl = ThisWorkbook.Names.Count + 1

有关您的代码的一些提示或问题

我不明白这部分代码的用途是什么:

'Inserts a copy of the row where the drop down list is going to be
celNm.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.Insert '?

'moves the cell to the appropriate location
celNm.Offset(0, -1).Value = "N/A"

我不明白这一部分。此外,如果用户选择A列中的单元格,这可能会导致错误

celNm.Offset(0, -1).Value = "N/A"

希望有所帮助,

答案 1 :(得分:1)

我只需检查strRange名称是否已存在于ThisWorkbook.names中就能解决此问题。以下是对上述代码的编辑:

For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNumLbl + 1
    strRange = strRange & strRngNumLbl
    If strRange = nm Then
        strRngNumLbl = strRngNumLbl + 1
        strRange = strRange & strRngNumLbl
    End If
Next nm