xlUp - выбранное значение 1 - и xlDown - выбранное значение 4121 - vba для раскрывающегося списка вместо -12 - PullRequest
0 голосов
/ 04 марта 2019

Я новичок в stackoverflow, наконец, участник после любопытного время от времени посетителя.До сих пор я всегда находил ответы здесь, но мне кажется, что я должен задать свой первый вопрос сегодня:

Я пытаюсь создать выпадающий список в Excel VBA на 1-м листе на основе списка, который я создал с помощьюзапрос на следующей вкладке.Выпадающий список активируется при открытии рабочей книги.Мне нужно, чтобы диапазон для раскрывающегося списка на листе 1 определялся путем выбора только непустых ячеек в столбце А. Я не могу строго ограничить свой диапазон, поскольку при обновлении запроса список на листе 2 может расширяться или уменьшаться.

Я создал короткий код, который странным образом работает один раз, а затем ломается: - с помощью xldown: выберите все ячейки на 4121 (12 из моего списка и оставьте пустым) - с помощью xlup: выберите только первую ячейку

Помощь будет очень признателен,

Private Sub Workbook_Open()

Application.ScreenUpdating = False

'DROPDOWN PROGRAM LIST

Worksheets("BANF code manager").Unprotect

Dim source_Prgm As Range
Dim Prgm_user As Range
Dim a As Integer

a = Cells(Rows.Count, 1).End(xlDown).Row

Set source_Prgm = Worksheets("lists").Range("A1:A" & a)
Set Prgm_user = Worksheets("BANF code manager").Range("E8")

ThisWorkbook.Names.Add Name:="source_Prgm", RefersTo:=source_Prgm
ThisWorkbook.Names.Add Name:="Prgm_user", RefersTo:=Prgm_user

With Prgm_user.Validation
    .Delete
    .Add Type:=xlValidateList, _
     AlertStyle:=xlValidAlertStop, Operator:= _
         xlBetween, Formula1:="=source_Prgm"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
 End With

1 Ответ

0 голосов
/ 05 марта 2019

Я решил проблему, добавив фильтр на пустые ячейки, сгенерированные функцией xldown.Я нашел практическое решение, но я все еще не понимаю причину этой ошибки из xlDown.Это также подразумевает много расчетов.Если у кого-то есть идея, как это оптимизировать, это будет высоко оценено

Private Sub Workbook_Open()

Application.ScreenUpdating = False

'DROPDOWN PROGRAM LIST

Worksheets("BANF code manager").Unprotect

Dim source_Prgm As Range
Dim Prgm_user As Range

Dim a As Long

 a = Cells(Rows.Count, 1).End(xlDown).Row
 j = 1

 For i = 1 To a
      If Cells(i, 1).Value = "" Then
      j = j + 0
      Else: j = j + 1
      End If

 Next

Set source_Prgm = Worksheets("lists").Range("A1:A" & j)
Set Prgm_user = Worksheets("BANF code manager").Range("E8")

ThisWorkbook.Names.Add Name:="source_Prgm", RefersTo:=source_Prgm
ThisWorkbook.Names.Add Name:="Prgm_user", RefersTo:=Prgm_user
...
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...