在 Excel 表中从 Word 表中查找值

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