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

Question

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

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

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

Answer 1

Попробуй это

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

Answer 2

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

Application.AddCustomList Selection

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

Answer 3

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

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