☰

Макрос Excel VBA для создания пользовательских списков из выбранного

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 macros vba
Макрос Excel VBA для создания пользовательских списков из выбранного

Привет, мне было интересно, может ли кто-нибудь помочь мне создать макрос, который добавит выборку в пользовательский список Excel. Обычно для этого я выбираю ряд строк в одном столбце, затем иду в Файл, Параметры, Дополнительно, прокручиваю до самого низа и нажимаю Изменить пользовательские списки. Когда я прохожу через это с включенным создателем макросов, все, что я получаю, это очень простой скрипт, который связан с определенными ячейками, которые я выбрал. Я хотел бы настроить код так, чтобы он использовал то, что я в данный момент выбрал, для добавления в пользовательский список. Таким образом, я не всегда привязан к диапазону J4-J9. Ниже приведен код, который я получаю.

Sub Customlistadd()
'
' Customlistadd Macro
'
' Keyboard Shortcut: Ctrl+Shift+I
'
    Application.AddCustomList ListArray:=Range("J4:J8")
End Sub

Это так же просто, как добавить текущий выбор вместо j4:j8? Если да, то как мне это точно написать? Нужно ли мне сначала объявить тип переменной для хранения текущего раздела? Почти все примеры, которые я рассматривал, которые, похоже, пытаются сделать что-то в духе того, что пытаюсь сделать я, как правило, используют переменные для хранения диапазона текущего выбора. Спасибо.

решение1

Измените свой код так, чтобы он использовал Selectionобъект, который всегда будет содержать текущие выбранные ячейки (если выбрано более 1 ячейки). т.е.

Application.AddCustomList Selection

И убедитесь, что ваш пользовательский список содержит только буквы, а не цифры. Например, A, B, C, D, E, F, G,... или A1, A2, A3, A4, A5, A6,... подойдут, но 1, 2, 3, 4, 5 — нет.

решение2

Попробуй это

Public Sub CreateCustomList()
  Dim v As Variant
  Dim rng As Excel.Range

  Set rng = ActiveSheet.Range("A1:A3")

  'Transpose from 2 dim array to 1 dim array
  v = Application.Transpose(Selection)

  'Add the custom list
  Application.AddCustomList v

End Sub

решение3

попробуйте это с add, get и delete custom list. Совет: пустые ячейки рассматриваются как счетный порядок, пожалуйста, не используйте пустые ячейки

Sub CoustomList()

    Dim Arr() As Variant
    Dim N As Long    
    Application.AddCustomList ListArray:=Sheet1.Range("A2:A4")
    Arr = Sheet1.Range("A2:A4")
    N = Application.GetCustomListNum(Arr)
    Application.DeleteCustomList N

End Sub

Связанный контент