Определение цеха-изготовителя для ТМЦ из таблицы Транспортных отношений

Option Explicit
 
Private Type typeTO
    Material As String 'какой нафиг материал, кронштейн - это изделие (или фамилия)
    IshMPL As String
    ZelMPL As String
End Type
 
Const m  As Integer = 100       ' количество материалов(изделий)
Const countTO As Integer = 1000 ' количество движений(перемещений) каждого материала
Dim Mat(1 To m, 1 To countTO) As typeTO
 
Private Sub Form_Load()
     Dim S, i As Integer, j As Integer
     i = 1 'поскольку материал пока один
     S = Split(Trim(CStr(Text2.Text)), vbCrLf) 'получаем данные из текстбокса(Вы не указали откуда)
     For j = 1 To UBound(S)
         Mat(i, j).Material = Trim(CStr(Text1.Text))
         Mat(i, j).IshMPL = Split(S(j - 1))(0)
         Mat(i, j).ZelMPL = Split(S(j - 1))(1)
     Next j
End Sub
 
Private Sub Command1_Click()
     Dim S As String, i As Integer
     For i = 1 To m
         If Mat(i, 1).Material = Trim(CStr(Text3.Text)) Then
           S = Mat(i, 1).IshMPL
           Exit For
         End If
     Next i
     If S = "" Then S = " не найден."
     MsgBox "Изготовитель материала """ & Text3.Text & """ - " & S
End Sub

Public Function findishod(nom, path, nameTbl, fldParent, fldChild, fldFilter, FilterValue)
'nom - начальное значение для поиска, например "23002902Э
'path - путь к БД, например "c:\temp\mydb.mdb"
'nameTbl - имя таблицы в БД, например "TRPROD"
'fldParent - имя поля выпускающего изделие, например "ИсхМПЛ"
'fldChild - имя поля принимающего изделие, например "ЦельМПЛ"
'fldFilter - имя поля фильтра, например "Материал"
'FilterValue - значение фильтра, например "Кронштейн"
    Dim k, s
    Dim rst As Object, cn As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & path & ";Mode=Share Deny None;Persist Security Info=False"
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open "select * from [" & nameTbl & "] where [" & fldFilter & "]='" & FilterValue & "'", _
         cn, adOpenDynamic
        
    k = nom
    With rst
    .MoveFirst
    While True
        .MoveFirst
        .Find fldChild & "='" & k & "'"
        If .EOF Then
            .MoveFirst
            .Find fldParent & "='" & k & "'"
            If Not .EOF Then
                MsgBox "Find " & .Fields(fldParent)
                findishod = .Fields(fldParent)
                Exit Function
            End If
        Else
            k = .Fields(fldParent)
        End If
    Wend
    End With
End Function

Public Function findishod(fldParent, fldFilter)
 
    Dim k, s
'    Dim rst As Object, cn As Object
'    Set cn = CreateObject("ADODB.Connection")
'    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & path & ";Mode=Share Deny None;Persist Security Info=False"
'    Set rst = CreateObject("ADODB.Recordset")
'    rst.Open "select * from [" & nameTbl & "] where [" & fldFilter & "]='" & FilterValue & "'", _
'         cn, adOpenDynamic
        
    k = txtMPL.Text
    With Data1.Recordset
    .MoveFirst
    While True
        .MoveFirst
        .Find fldChild & "='" & k & "'"
        If .EOF Then
            .MoveFirst
            .Find fldParent & "='" & k & "'"
            If Not .EOF Then
                MsgBox "Find " & .Fields(fldParent)
                findishod = .Fields(fldParent)
                Exit Function
            End If
        Else
            k = .Fields(fldParent)
        End If
    Wend
    End With
End Function
 
Private Sub Command1_Click()
MsgBox findishod(txtMPL.Text, txtMATNR.Text)
End Sub