📅 Заполнение ComboBox названиями месяцев
Три способа заполнения поля со списком (ComboBox) названиями месяцев.

📌 Примеры

1️⃣ Загружаем в ComboBox список месяцев на русском языке, по умолчанию отображаем Январь:

Private Sub UserForm_Initialize()
    With ComboBox1
        .List = Array("Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", _
            "Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь")
        .Value = "Январь"
    End With
End Sub

Если же необходимо загрузить в ComboBox названия месяцев на языке пользователя, используем 2 и 3 примеры.

2️⃣ Загружаем в ComboBox список месяцев на языке пользователя, по умолчанию отображаем первый месяц:

Private Sub UserForm_Initialize()
    With ComboBox1
        .List = Array(MonthName(1), MonthName(2), MonthName(3), MonthName(4), _
            MonthName(5), MonthName(6), MonthName(7), MonthName(8), _
            MonthName(9), MonthName(10), MonthName(11), MonthName(12))
        .Value = MonthName(1)
    End With
End Sub

3️⃣ То же самое, что и во втором примере, но с помощью цикла:

Private Sub UserForm_Initialize()
Dim i As Byte
    With ComboBox1
        For i = 1 To 12
            .AddItem MonthName(i)
        Next
            .Value = MonthName(1)
    End With
End Sub

#VBA #ExcelVBA #ComboBox #AddItem #List #MonthName

✨ Отбор уникальных значений из списка
Нетрадиционный способ отбора уникальных значений из списка в VBA Excel. Используем объект Dictionary.

📌 Примеры

1️⃣ Отбор уникальных значений из столбца A и выгрузка их на рабочий лист в столбец B:

Sub Primer1()
Dim myDictionary As Object, myCell As Range, myElement As Variant
    Set myDictionary = CreateObject("Scripting.Dictionary")
        'Отбор уникальных значений из списка в столбце A
        For Each myCell In Range("A1:A20")
          myElement = myDictionary.Item(CStr(myCell))
        Next
    'Выгрузка уникальных значений на рабочий лист в столбец B
    Range("B1").Resize(myDictionary.Count) = Application.Transpose(myDictionary.Keys)
End Sub

Как работает этот код?
🔹 При присвоении переменной myElement значения myDictionary.Item(CStr(myCell)) с несуществующем ключом, значение myCell записывается как ключ, а как значение записывается Empty, которое и присваивается переменной myElement.
🔹 Если значение myCell повторяется, оно игнорируется, так как все ключи в myDictionary должны быть уникальными.
🔹 Списком уникальных значений является полученный список ключей словаря (myDictionary.Keys), которые мы выгружаем на рабочий лист в колонку B.
🔹 Транспонирование (Application.Transpose) необходимо для того, чтобы горизонтальный список ключей словаря вставить в вертикальный список в столбце B.

2️⃣ Отбор уникальных значений из столбца A и выгрузка их в поле со списком (ComboBox):

Sub Primer2()
Dim myDictionary As Object, myCell As Range, myElement As Variant
    Set myDictionary = CreateObject("Scripting.Dictionary")
        'Отбор уникальных значений из списка в столбце A
        For Each myCell In Range("A1:A20")
          myElement = myDictionary.Item(CStr(myCell))
        Next
    'Выгрузка уникальных значений в поле со списком
    With UserForm1
        .ComboBox1.List = myDictionary.Keys
        .Show
    End With
End Sub

#VBA #ExcelVBA #Dictionary #ОтборУникальных #УникальныеЗначения #ComboBox

🎛 Программное создание элементов управления

Рассмотрим программное (динамическое) создание элементов управления формы в VBA Excel для отображения расстояний от Солнца до планет Солнечной системы. Созданный элемент ComboBox будет реагировать на событие ComboBox_Change().

1️⃣ Создайте пользовательскую форму.
2️⃣ Разместите код в модуле формы.

📌 Код VBA Excel

Option Explicit
'Объявляем переменные для создания меток
Dim lb1, lb2
'Объявляем переменную для поля со списком,
'которая будет обрабатывать события
'благодаря ключевому слову WithEvents
Private WithEvents cb1 As MSForms.ComboBox


Private Sub UserForm_Initialize()
With Me
    .Height = 170
    .Width = 305
    .Caption = "Расстояние от Солнца до планет Солнечной системы"
    'Программно создаем элементы управления
    Set lb1 = .Controls.Add("Forms.Label.1")
    Set lb2 = .Controls.Add("Forms.Label.1")
    Set cb1 = .Controls.Add("Forms.ComboBox.1")
End With

With lb1
    .Height = 22
    .Width = 290
    .Top = 60
    .Left = 18
    .Font.Size = 12
    .Caption = "Расстояние от Солнца до выбранной планеты"
End With

With lb2
    .Caption = ""
    .Height = 22
    .Width = 290
    .Top = 90
    .Left = 18
    .Font.Size = 14
End With

With cb1
    .Height = 22
    .Width = 150
    .Top = 20
    .Left = 18
    .Font.Size = 12
    .List = Array("Меркурий", "Венера", "Земля", _
    "Марс", "Юпитер", "Сатурн", "Уран", "Нептун")
    .Value = "Выберите планету"
End With
End Sub


Private Sub cb1_Change()
Dim pl(), km()
pl = Array("Меркурия", "Венеры", "Земли", _
    "Марса", "Юпитера", "Сатурна", "Урана", "Нептуна")
km = Array("57,91 млн км (0,387 а. е.)", "108 млн км (0,723 а. е.)", _
    "149,6 млн км (1 а. е.)", "228 млн км (1,52 а. е.)", _
    "778,57 млн км (5,2 а. е.)", "1,43 млрд км (9,58 а. е.)", _
    "2,87 млрд км (19,1914 а. е.)", "4,55 млрд км (30,1 а. е.)")
        If cb1.ListIndex > -1 Then
            lb1.Caption = "Расстояние от Солнца до " & pl(cb1.ListIndex) & ":"
            lb2.Caption = km(cb1.ListIndex)
        End If
End Sub

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

#VBA #ExcelVBA #Элемент #ComboBox #Label #Создание