Пользовательская форма - поиск и возможность обновления

Option Explicit
Dim Data As Variant
Private Sub UserForm_Initialize()
    Me.cboxCountry.List = Array("USA", "UK", "FR", "DE")
    Me.cboxLabCount.List = Array(1, 2, 3, 4, 5)

    ' Update with your data
    With Sheet1
        Data = .Range("A1:D4")
    End With

    Me.ListBox1.List = Data
End Sub
Private Sub TextBox1_Change()
    Me.ListBox1.List = FilteredResults(Me.TextBox1.Value)
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim i As Long
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then Exit For
        Next i

        Me.tbCenterID.Value = .List(i, 0)
        Me.tbCenterName.Value = .List(i, 1)
        Me.cboxCountry.Value = .List(i, 2)
        Me.cboxLabCount.Value = .List(i, 3)
    End With
End Sub
Private Function FilteredResults(SearchValue As String) As Variant
    Dim tmp As Variant
    Dim i As Long
    Dim ResultCounter As Long
    ReDim tmp(LBound(Data, 2) To UBound(Data, 2), LBound(Data, 1) To UBound(Data, 1))

    If SearchValue = vbNullString Then
        FilteredResults = Data
    Else
        For i = LBound(Data, 1) To UBound(Data, 1)
            If Levenshtein(CStr(Data(i, 1)), SearchValue) Or _
               Levenshtein(CStr(Data(i, 2)), SearchValue) Or _
               Levenshtein(CStr(Data(i, 3)), SearchValue) Or _
               Levenshtein(CStr(Data(i, 4)), SearchValue) _
            Then
                ResultCounter = ResultCounter + 1
                tmp(1, ResultCounter) = Data(i, 1)
                tmp(2, ResultCounter) = Data(i, 2)
                tmp(3, ResultCounter) = Data(i, 3)
                tmp(4, ResultCounter) = Data(i, 4)
            End If
        Next i
        If ResultCounter > 0 Then
            ReDim Preserve tmp(LBound(tmp, 1) To UBound(tmp, 1), LBound(tmp, 2) To ResultCounter)
        End If
        FilteredResults = Transpose2DArray(tmp)
    End If
End Function
Private Function Transpose2DArray(tmpArray As Variant) As Variant
    Dim tmp As Variant
    Dim i As Long, j As Long
    ReDim tmp(LBound(tmpArray, 2) To UBound(tmpArray, 2), LBound(tmpArray, 1) To UBound(tmpArray, 1))

    For i = LBound(tmpArray, 1) To UBound(tmpArray, 1)
        For j = LBound(tmpArray, 2) To UBound(tmpArray, 2)
            tmp(j, i) = tmpArray(i, j)
        Next j
    Next i
    Transpose2DArray = tmp
End Function
Private Function Levenshtein(s1 As String, s2 As String) As Double
    Dim i As Integer
    Dim j As Integer
    Dim l1 As Integer
    Dim l2 As Integer
    Dim d() As Integer
    Dim min1 As Integer
    Dim min2 As Integer

    l1 = Len(s1)
    l2 = Len(s2)
    ReDim d(l1, l2)
    For i = 0 To l1
        d(i, 0) = i
    Next
    For j = 0 To l2
        d(0, j) = j
    Next
    For i = 1 To l1
        For j = 1 To l2
            If Mid(s1, i, 1) = Mid(s2, j, 1) Then
                d(i, j) = d(i - 1, j - 1)
            Else
                min1 = d(i - 1, j) + 1
                min2 = d(i, j - 1) + 1
                If min2 < min1 Then
                    min1 = min2
                End If
                min2 = d(i - 1, j - 1) + 1
                If min2 < min1 Then
                    min1 = min2
                End If
                d(i, j) = min1
            End If
        Next
    Next
    Levenshtein = 1 - (d(l1, l2) / Len(s2))
End Function

Я обновил это с помощью функции поиска демо. Вам нужно будет обновить UserForm_Initialize с вашим диапазоном данных. Вы можете изменить несколько вещей для этого, и это также может быть легко расширено, но это быстрая демонстрация. Я также использую событие TextBox1_Change вместо нажатия кнопки поиска, но опять же, это можно легко изменить. Код использует коэффициент Левенштейна для своей функции поиска, чтобы попытаться сравнить похожие строки. Опять же, есть и другие способы достижения этого.

Вам также нужно будет настроить его в зависимости от того, что вы хотите искать. Это учитывает каждый столбец вашего набора данных по отдельности и возвращает все, что соответствует.