Option Explicit
Dim x

Private Sub UserForm_Initialize() 'Задаём диапазон значений для Комбобокса
Dim i& 'Присваиваем i значение строки
    With Sheets("БД")
        If .FilterMode Then .ShowAllData
        x = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
    End With
    
    'ВАРИАНТ 1
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(x)
            If Not .Exists(x(i, 1)) Then .Item(x(i, 1)) = Empty    'Значение из БД
        Next i
        Me.ComboBox1.List = .keys
    End With
    Call ReFillCombobox2 '!!!!!!!!!!!!
End Sub

Private Sub ComboBox1_Change()
    Call ReFillCombobox2
End Sub

Private Sub ReFillCombobox2()
Dim i As Integer
Dim v As Variant
Dim txt As String
    txt = ComboBox1.Text
    With Worksheets(1)
        v = .Cells(2, 1).Resize(.Cells(.Rows.Count - 1, 1).End(xlUp).Row, 4)
    End With
    ComboBox2.Clear
    If (txt <> "") Then
        For i = 1 To UBound(v)
            If (v(i, 4) = txt) Then
                ComboBox2.AddItem v(i, 1)
            End If
        Next i
    Else
        For i = 1 To UBound(v)
            ComboBox2.AddItem v(i, 1)
        Next i
    End If
End Sub


ComboBox1.List = .Range("D7", .Cells(Rows.Count, "D").End(xlUp)).Value

TextBoxDateCorrect = Sheets("Лист1").Cells(Me.ComboBox1.ListIndex + 7, 5)
ComboBox_FormUL = Sheets("Лист1").Cells(Me.ComboBox1.ListIndex + 7, 6)
Me.TextBox2 = Sheets("Лист1").Cells(Me.ComboBox1.ListIndex + 7, 7)
Me.TextBox3 = Sheets("Лист1").Cells(Me.ComboBox1.ListIndex + 7, 8)

Option Explicit
Dim x
Dim indxs() As Integer

Private Sub UserForm_Initialize() 'Задаём диапазон значений для Комбобокса
Dim i& 'Присваиваем i значение строки
    With Sheets("БД")
        If .FilterMode Then .ShowAllData
        x = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
    End With
    
    'ВАРИАНТ 1
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(x)
            If Not .Exists(x(i, 1)) Then .Item(x(i, 1)) = Empty    'Значение из БД
        Next i
        Me.ComboBox1.List = .keys
    End With
    Call ReFillCombobox2 '!!!!!!!!!!!!
End Sub

Private Sub ComboBox1_Change()
    Call ReFillCombobox2
End Sub

Private Sub ReFillCombobox2()
Dim i As Integer, k As Integer
Dim v As Variant
Dim txt As String

    ReDim indxs(0 To 0)
    txt = ComboBox1.Text
    With Sheets("ОБЪЕКТЫ") 'С листа "ОБЪЕКТЫ"
    'v = .Cells(2, 1).Resize(.Cells(.Rows.Count - 1, 1).End(xlUp).Row, 4 ИЩЕМ ЗНАЧЕНИЯ В СТОЛБЦЕ 4)
        v = .Cells(2, 1).Resize(.Cells(.Rows.Count - 1, 1).End(xlUp).Row, 4)
    End With
    ComboBox2.Clear
    If (txt <> "") Then
        For i = 1 To UBound(v) - 1
    'If (v(i, 4) = txt)ТОЖЕ МЕНЯЕМ Then ЕСЛИ В СТОЛБЦЕ 4 = ТЕКСТ)
            If (v(i, 4) = txt) Then
                ReDim Preserve indxs(0 To k)
' ComboBox2.AddItem v(i, 1) ВОТ ТУТ НОМЕР СТОЛБЦА ОТКУДА БЕРЁМ ОБЪЕКТ
                ComboBox2.AddItem v(i, 1)
                indxs(k) = i + 1
                k = k + 1
            End If
        Next i
    Else
        ReDim indxs(0 To (UBound(v) - 2))
        For i = 1 To UBound(v) - 1
' ComboBox2.AddItem v(i, 1) ТУТ НОМЕР СТОЛБЦА ОТКУДА БЕРЁМ ОБЪЕКТ ТОЖЕ ПОМЕНЯТЬ
            ComboBox2.AddItem v(i, 1)
            indxs(i - 1) = i + 1
        Next i
    End If
End Sub

Sub ComboBox2_Change()
'Присвоить Textbox с листа "ХХХ" значение выбранного в ComboBox диапазона. Смещаем +y вниз, z вправо
'------------------------------------------------С ЛИСТА "ОБЪЕКТ"--------------------------------------------------------------------
'Сведения об объекте, контактные лица
Dim n As Integer
n = Me.ComboBox2.ListIndex
If (n > -1) Then
    Me.TextBox1 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 2) 'Данные 1
    Me.TextBox2 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 3) 'Данные 2
    Me.TextBox3 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 4) 'Значение из БД
    Me.TextBox4 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 5) 'Данные 3
    Me.TextBox5 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 6) 'Данные 4
    Me.TextBox6 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 7) 'Данные 5
End If
End Sub


ReDim indxs(0 To 0)
    txt = ComboBox1.Text
    With Sheets("ОБЪЕКТЫ") 'С листа "ОБЪЕКТЫ"
    'v = .Cells(2, 1).Resize(.Cells(.Rows.Count - 1, 1).End(xlUp).Row, Х)        ИЩЕМ ЗНАЧЕНИЯ В СТОЛБЦЕ Х
        v = .Cells(2, 1).Resize(.Cells(.Rows.Count - 1, 1).End(xlUp).Row, 29)
    End With
    ComboBox2.Clear
    If (txt <> "") Then
                    'For i = XZ To UBound(v) - 1     XZ - Строка, с которой ищем значения
        For i = 6 To UBound(v) - 1
                    'If (v(i, Х) = txt)       ЗНАЧЕНИЯ В СТОЛБЦЕ Х ТОЖЕ МЕНЯЮ
            If (v(i, 29) = txt) Then
                ReDim Preserve indxs(0 To k)
                    ' ComboBox2.AddItem v(i, YY) YY - НОМЕР СТОЛБЦА ОТКУДА БЕРЁМ ОБЪЕКТ МЕНЯЮ
                ComboBox2.AddItem v(i, 4)
                indxs(k) = i + 1
                k = k + 1
            End If
        Next i
    Else
        ReDim indxs(0 To (UBound(v) - 2))
        For i = 1 To UBound(v) - 1
                    ' ComboBox2.AddItem v(i, 1)  ТУТ НОМЕР СТОЛБЦА ОТКУДА БЕРЁМ ОБЪЕКТ ТОЖЕ МЕНЯЮ
            ComboBox2.AddItem v(i, 4)
            indxs(i - 1) = i + 1
        Next i
    End If
End Sub

Option Explicit
Dim x
Dim indxs() As Integer

Private Sub UserForm_Initialize() 'Задаём диапазон значений для Комбобокса
Dim i& 'Присваиваем i значение строки
    With Sheets("БД")
        If .FilterMode Then .ShowAllData
        x = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
    End With
    
    'ВАРИАНТ 1
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(x) 'Берём со строки 2!!! столбца А на листе БД
            If Not .Exists(x(i, 1)) Then .Item(x(i, 1)) = Empty    'Значение из БД
        Next i
        Me.ComboBox1.List = .keys
    End With
    Call ReFillCombobox2 '!!!!!!!!!!!!
End Sub

Private Sub ComboBox1_Change()
    Call ReFillCombobox2
End Sub

Private Sub ReFillCombobox2()
Dim i As Integer, k As Integer
Dim v As Variant
Dim txt As String
Dim cnt As Integer, maxIndx As Integer
Dim offstRow As Integer, offstClmn As Integer
    ReDim indxs(0 To 0)
    txt = ComboBox1.Text
    offstRow = 7 'интересуемый диапазон начинается с 7й строки
    offstClmn = 4 'интересуемый диапазон начинается с 4-го столбца
    With Sheets("ОБЪЕКТЫ") 'С листа "ОБЪЕКТЫ"
    'v = .Cells(2, 1).Resize(.Cells(.Rows.Count - 1, 1).End(xlUp).Row, Х) ИЩЕМ ЗНАЧЕНИЯ В СТОЛБЦЕ Х
        v = .Cells(offstRow, offstClmn).Resize(.Cells(.Rows.Count, 4).End(xlUp).Row - offstRow + 1, 29) 'интересуемый диапазон начинается с 7й строки 4-го столбца, включает 29 столбцов и n строк
    End With
    cnt = UBound(v) 'к-во строк в массиве v
    maxIndx = cnt - 1
    
    ComboBox2.Clear
    If (txt <> "") Then
        For i = 1 To cnt
            If (v(i, 26) = txt) Then
                ReDim Preserve indxs(0 To k)
                ComboBox2.AddItem v(i, 1)
                indxs(k) = i + offstRow - 1
                k = k + 1
            End If
        Next i
    Else
        ReDim Preserve indxs(0 To maxIndx)
        For i = 1 To cnt
            ComboBox2.AddItem v(i, 1)
            indxs(i - 1) = i + offstRow - 1
        Next i
    End If
End Sub

Sub ComboBox2_Change()
'Присвоить Textbox с листа "ХХХ" значение выбранного в ComboBox диапазона. Смещаем +y вниз, z вправо
'------------------------------------------------С ЛИСТА "ОБЪЕКТ"--------------------------------------------------------------------
Dim n As Integer
n = Me.ComboBox2.ListIndex
If (n > -1) Then
    Me.TextBox1 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 2) 'Данные 1
    Me.TextBox2 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 3) 'Данные 2
    Me.TextBox3 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 4) 'Значение из БД
    Me.TextBox4 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 5) 'Данные 3
    Me.TextBox5 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 6) 'Данные 4
    Me.TextBox6 = Sheets("ОБЪЕКТЫ").Cells(indxs(n), 7) 'Данные 5
End If
End Sub

For i = 2 To UBound(x) 'Берём со строки 2!!! столбца А на листе БД