Public Sub Conn()
    Dim Cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim strQuery As String
    Dim array1 As Variant
    
    ' Инициализация подключения
    Set Cnn = New ADODB.Connection

    ' Строка подключения
    Cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\Test\Test.xlsm;" & _
                           "Extended Properties='Excel 12.0 Xml; HDR=YES;'"
   
    ' Открытие подключения
    Cnn.Open

    ' SQL-запрос (убедитесь, что имена столбцов корректны и матчятся с заголовками в Excel)
    strQuery = "SELECT [Наименование], [Марка] FROM [Лист1$] WHERE [Артикул] = 'RG58'"

    ' Выполнение запроса
    Set rst = Cnn.Execute(strQuery)
    
    ' Получение данных в массив
    array1 = rst.GetRows()

    ' Закрываем Recordset и соединение
    rst.Close
    Cnn.Close

    ' Освобождаем ресурсы
    Set rst = Nothing
    Set Cnn = Nothing
End Sub

Public Sub GetDataFromActiveWorkbook()    Dim ws As Worksheet
   Dim rng As Range
   Dim array1 As Variant
   Dim i As Long
   Dim result As String
   
   ' Проверяем, есть ли открытая книга
   If Application.Workbooks.Count = 0 Then
       MsgBox "Нет открытых книг Excel"
       Exit Sub
   End If


   ' Устанавливаем активный лист (или вы можете указать конкретный лист)
   Set ws = ActiveWorkbook.Sheets("Лист1")
   
   ' Указываем диапазон: замените A1:C10 на нужный вам диапазон
   Set rng = ws.Range("A1:C10")
   
   ' Получаем данные в массив
   array1 = rng.Value
   
   ' Выводим данные (пример), чтобы показать результат
   For i = LBound(array1, 1) To UBound(array1, 1)
       result = result & array1(i, 1) & " " & array1(i, 2) & vbNewLine
   Next i


   ' Показываем результат в сообщении
   MsgBox result


   ' Освобождаем ресурсы
   Set rng = Nothing
   Set ws = Nothing
End Sub

Option Explicit

Dim ws As Worksheet
Dim rng As Range
Dim array1 As Variant
Dim i As Long
Dim result As String

' Глобальные переменные для доступа из других процедур
Public result As String
Public array1 As Variant

Public Sub GetDataFromActiveWorkbook() 
    ' Проверяем, есть ли открытая книга
    If Application.Workbooks.Count = 0 Then
        MsgBox "Нет открытых книг Excel"
        Exit Sub
    End If

    ' Устанавливаем активный лист (или вы можете указать конкретный лист)
    Set ws = ActiveWorkbook.Sheets("Лист1")
    
    ' Указываем диапазон: замените A1:C10 на нужный вам диапазон
    Set rng = ws.Range("A1:C10")
    
    ' Получаем данные в массив
    array1 = rng.Value
    
    ' Выводим данные (пример), чтобы показать результат
    result = ""
    For i = LBound(array1, 1) To UBound(array1, 1)
        result = result & array1(i, 1) & " " & array1(i, 2) & vbNewLine
    Next i

    ' Освобождаем ресурсы
    Set rng = Nothing
    Set ws = Nothing
End Sub

Public Sub UserForm_Initialize()
    Application.Visible = True
    Call GetDataFromActiveWorkbook
    
    ' Теперь мы можем присвоить значения полям
    UserForm1.TextBox1.Value = result
    UserForm1.ComboBox1.Value = array1(1, 1) ' Убедитесь, что этот элемент действительно существует в массиве
End Sub

Private Sub TextBox1_Change()
    ' Если нужно обрабатывать изменение текста
    ' Например, возможно, вы хотите просто обновить ComboBox здесь.
End Sub

Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset

rst.Open "SELECT [Наименование], [Марка] FROM [Лист1$] WHERE [Артикул] = 'RG58'", cn, adOpenStatic, adLockReadOnly

If Not rst.EOF Then
    rst.MoveLast ' Переместить указатель на последний элемент
    Dim recordCount As Long
    recordCount = rst.RecordCount ' теперь это должно работать
    rst.MoveFirst ' Вернуться к первому элементу
Else
    MsgBox "Записи не найдены"
End If

Private Sub ComboBox2_AfterUpdate()
    Dim J As Integer
    Dim idValue As String
    Dim i As Long

    J = ComboBox2.ListIndex
    If J >= 0 Then
        idValue = ComboBox2.List(J)
        
        ' Теперь мы ищем этот idValue в массиве array2
        For i = LBound(array2, 1) To UBound(array2, 1)
            If array2(i, 1) = idValue Then ' Предполагается, что ID в первом столбце
                ' Обновляем остальные ComboBox на основе найденного индекса
                UserForm1.ComboBox3.Value = array2(i, 2) ' Например, колонка Специальность
                UserForm1.ComboBox4.Value = array2(i, 3) ' Например, колонка Город
                ' Добавьте здесь дальнейшие обновления полей по своему усмотрению
                Exit For
            End If
        Next i
    End If
End Sub

Private Sub ComboBox1_AfterUpdate()
    Dim i As Long
    Dim uniqueSpecialties As Collection
    Set uniqueSpecialties = New Collection
    
    ' Очищаем ComboBox2 перед добавлением новых данных
    ComboBox2.Clear

    ' Просматриваем все значения и собираем уникальные Специальности
    For i = LBound(array2, 1) To UBound(array2, 1)
        If array2(i, 1) = ComboBox1.Value Then ' Проверяем Вид деятельности
            On Error Resume Next ' Игнорируем ошибку, если элемент уже присутствует
            uniqueSpecialties.Add array2(i, 2), CStr(array2(i, 2)) ' Колонка Специальности
            On Error GoTo 0
        End If
    Next i

    ' Заполняем ComboBox2 уникальными значениями
    For Each specialty In uniqueSpecialties
        ComboBox2.AddItem specialty
    Next specialty
End Sub