Создание нескольких списков проверки данных без обращения к одному и тому же диапазону EXCEL VBA - PullRequest
Новая
       49

Создание нескольких списков проверки данных без обращения к одному и тому же диапазону EXCEL VBA

0 голосов
/ 28 июля 2011

Я пишу макрос в 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 ]

1 голос
/ 02 августа 2011

Мне удалось решить эту проблему, просто проверив, было ли имя 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
1 голос
/ 29 июля 2011

Решение вашей проблемы

Вместо: 

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"

Надеюсь, это поможет,

...