创build多个数据validation列表，而不参考相同的范围EXCEL VBA

我在Excel VBA中创build一个macros，在指定的单元格中创build一个数据validation列表。 程序然后提示用户input包含数据validation列表内容的单元格。 然后包含列表内容的相同行将被隐藏起来。 但是，当我多次尝试重新运行macros时，每次为内容select新的范围时，每个进程列表都会引用此范围。 我不想要这样的事情发生。

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

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

其中strRng是添加到数据validation时要引用的范围的名称。 但是，由于某些原因，这是行不通的。 我认为这将工作，因为它会创build每个范围的独立名称添加到列表。 但它不…

这是整个代码：

 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 

有什么build议么？

Answer 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中select一个单元格， 这可能会导致错误

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

希望有所帮助，

Answer 2

我能够通过检查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