Найдите значения из таблицы Word в таблице Excel

Question

Я хочу перебрать значения столбца в таблице в файле Word и проверить, находятся ли эти значения в столбце таблицы в файле Excel. У меня есть следующий код:

Private Sub CompararColumnas_Click()

   Dim wrdTbl As Table
    'Set your table
    With ActiveDocument
        If ActiveDocument.Tables.Count >= 1 Then
            Set wrdTbl = .Tables(InputBox("Table # to copy? There are " & .Tables.Count & " tables to choose from."))
        End If
    End With

    Dim AD_UsersPath As String
    AD_UsersPath = "C:\Users\" & Environ("Username") & "\Desktop\Comparar Columnas VBA\Animales.xlsx"
    Dim AD_USERS As Object
    Set AD_USERS = CreateObject("Excel.Application")
    AD_USERS.Visible = False
    AD_USERS.Application.Workbooks.Open AD_UsersPath
    
    LastRow = ThisDocument.Tables(1).Columns(1).Cells.Count
    Dim I As Integer
    For I = 1 To LastRow
        wVal = ThisDocument.Tables(1).Cell(I, 1)
        User = AD_USERS.Cells(AD_USERS.Range("A:A").Find(What:=wVal).Row, 1).Text
        wrdTbl.Cell(I, 2).Range.Text = User
    Next I

End Sub

Этот код повторяет в wVal значения из первого столбца в таблице из Word, а затем переходит в Excel, чтобы найти эти значения в первом столбце Таблица Excel. Если он их находит, он копирует значения во второй столбец таблицы слов. Однако это дает мне ошибку 91. Если вместо Find(What:=wVal) я помещаю что-то вроде Find(What:="Word"), это не дает мне ошибки и помещает слово «Word» в каждую ячейку второго столбца таблицы слов. Как я могу это решить?

Answer 1

Значения ячеек в Word имеют двухсимвольный маркер «конца ячейки» (Chr (13) + Chr (7)), который необходимо удалить:

Private Sub CompararColumnas_Click()

   Dim wrdTbl As Table
    'Set your table
    With ActiveDocument
        If ActiveDocument.Tables.Count > 1 Then
            Set wrdTbl = .Tables(InputBox("Table # to copy? There are " & _
                                  .Tables.Count & " tables to choose from."))
        Else
            Set wrdTbl = .Tables(1) 'default to the only table
        End If
    End With

    Dim AD_UsersPath As String, wb As Object, ws As Object
    AD_UsersPath = "C:\Users\" & Environ("Username") & _
                   "\Desktop\Comparar Columnas VBA\Animales.xlsx"
    Dim AD_USERS As Object
    Set AD_USERS = CreateObject("Excel.Application")
    AD_USERS.Visible = False
    Set wb = AD_USERS.Workbooks.Open(AD_UsersPath)
    Set ws = wb.Worksheets(1)
    
    Dim LastRow As Long, I As Long, User
    LastRow = wrdTbl.Columns(1).Cells.Count
    
    For I = 1 To LastRow
        wVal = TwrdTbl.Cell(I, 1)
        Left(wVal, Len(wVal)-2) 'strip off "end of cell" marker
        User = ws.Cells(ws.Range("A:A").Find(What:=wVal).Row, 1).Text
        wrdTbl.Cell(I, 2).Range.Text = User
    Next I

    wb.Close False
    AD_USERS.Quit

End Sub