Прочитайте текстовый файл и заполните выпадающий список

Question

Я работаю над сценарием Excel vba, который читает текстовый файл (test.txt) и заполняет раскрывающийся список. Раскрывающийся список содержит следующие элементы:

яблоко
груши
лимон
лайм

в текстовом файле:

яблоки
яблоко ломтики
Большое яблоко
Лимонный сок
Лимон
Груша ломтиками

Что я хотел бы получить, когда он читает кусочки Apple в текстовом файле в раскрывающемся списке, который он установлен как Apple. То же самое, когда написано «Большое яблоко», в раскрывающемся списке указано «Apple».

Вот мой код

Sub CopyTXT()

    Dim myFile, textline
    Dim compare As String
    Dim sArray() As String
    Dim mywnd As Long
    Dim i As Integer
    Dim cell As Range
    Dim dbsheet As Worksheet
    Dim myArray() As Variant
    Dim myTable As ListObject
    Dim x As Long

    Set myTable = Worksheets("Sheet2").ListObjects("Table3")
    TempArray = myTable.DataBodyRange.Columns(1)
    myArray = Application.Transpose(TempArray)

    Set dbsheet = ThisWorkbook.Sheets("Sheet1")
    lr = dbsheet.Cells(Rows.Count, 1).End(xlUp).Row
    Charr = Chr$(160)
    myFile = "test.txt"

    For y = 1 To lr
        If Not dbsheet.Cells(y, 1) = Charr Then
            Close #1
             Open myFile For Input As #1
            Do Until EOF(1)
                Line Input #1, textline
                    For x = LBound(myArray) To UBound(myArray)
                    If InStr(1, textline, myArray(x), vbTextCompare) > 0 Then
                        dbsheet.Cells(y, 1).Value = textline
                        x = x + 1
                    End If
                    Next x
                y = y + 1
            Loop
        End If
    Next
        Close #1
    End Sub

Answer 1

На основании моего первого комментария

Если я правильно понял, ваш массив myArray содержит правильные значения из одного слова, как в раскрывающемся списке, которые должны быть заполнены на листе. В этом случае, если вы сопоставляете входные данные If InStr(1, textline, myArray(x), vbTextCompare) > 0 Then с элементом в вашем массиве - вы должны назначить значение из массива в ячейку, а не текстовую строку: dbsheet.Cells(y, 1).Value = myArray(x)

И пояснение ОП, я есть предположение, что следующее может помочь, но это слишком долго для комментариев и требует форматирования, поэтому отправка в качестве ответа:

Dim z As Long

For x = LBound(myArray) To UBound(myArray)
    ' in case there is a partial match found in line
    If InStr(1, textline, myArray(x), vbTextCompare) > 0 Then
        ' perform a word by word check of that line:
        ' put words to an array by splitting the text line with a space as delimiter
        For z = LBound(Split(textline, " ")) To UBound(Split(textline, " "))
            ' if one of words exactly matches the mask (myArray(x))
            If Split(textline, " ")(z) = myArray(x) Then
                ' then put it into a cell
                dbsheet.Cells(y, 1).Value = textline
                x = x + 1
            End If
        Next
    End If
Next x

Но это не сработает для сравнения Apple и Apple, нужно подумать это.