根据excl表头查找word表格内符合条件内容位置

ndt3

如题，
在excl中逐个查找表头号在word表格中的坐标，并填充到相应列中。
下面这段代码，是word中提供展示word表格每个单元格地址的。
就是不知道excl vba怎么操作数据。谢谢各位！

Sub 展示单元格行列号()'word中自动填写每个单元格位置
    Dim tbl As Table
    Dim cel As Cell
    For Each tbl In Me.Tables
        For Each cel In tbl.Range.Cells
            With cel
                .Range.Text = .Range.Text & "(" & .RowIndex & "," & .ColumnIndex & ")"
            End With
        Next
    Next
End Sub

ndt3

都没人看

m_n_j001

把你的代码改成Excel中使用，结果填到E中A列单元格：
Sub test()
Dim Wd As New Word.Application
Wd.Visible = 0
Wd.Documents.Open ThisWorkbook.Path & "\模拟表格2 表头位置.doc"
r = 1
For Each tbl In Wd.ActiveDocument.Tables
    For Each cel In tbl.Range.Cells
           Cells(r, 1) = cel.Range.Text & "(" & cel.RowIndex & "," & cel.ColumnIndex & ")"
           r = r + 1
     Next
Next
Wd.Quit
Set Wd = Nothing
End Sub

ndt3

m_n_j001 发表于 2019-10-23 09:05
把你的代码改成Excel中使用，结果填到E中A列单元格：
Sub test()
Dim Wd As New Word.Application

谢谢，老师的帮助！
现在的问题是：
1、如果运行第二遍就会导致word文件锁定，文件无法打开；
2、我的目标是查找到sheet1符合第一行中的数据返回，这个是全部返回；
十分感谢您的帮助！谢谢！

EXCELLMY

ndt3 发表于 2019-10-23 10:28
谢谢，老师的帮助！
现在的问题是：
1、如果运行第二遍就会导致word文件锁定，文件无法打开；

工具---引用---WORD

ndt3

EXCELLMY 发表于 2019-10-23 11:12
工具---引用---WORD

已经引用过了。

ndt3

Sub 查找定位()
    Dim WordApp, wordD
    Dim cPath$, cFile$, i%, h, l, str1
    cPath = ThisWorkbook.Path & "\"
    cFile = Dir(cPath & "*.doc?")
    Set WordApp = CreateObject("word.Application")
    Set str1 = Sheets("sheet1").Range("d1")
    Do While cFile <> ""
        Set wordD = WordApp.Documents.Open(cPath & cFile)
        i = i + 1
        With wordD.Tables(1)
           If wordD.Tables(1).Select.Find.Execute(str1) <> False Then '要求对象？
            h = .RowIndex
            l = .ColumnIndex
         End If
        End With
        wordD.Close
        cFile = Dir
    Loop
    Set wordD = Nothing
    WordApp.Quit
     MsgBox h & l
End Sub
这段代码也是不行

m_n_j001

以下是找 "职务" 所在的行，拿去改吧
Sub test()
Dim Wd As New Word.Application
Wd.Visible = 1
Wd.Documents.Open ThisWorkbook.Path & "\模拟表格2 表头位置.doc"
Wd.ActiveDocument.Tables(1).Select
Wd.Selection.Find.Execute FindText:="职务", Forward:=True
MsgBox "职务在第" & Wd.Selection.Cells(1).RowIndex & "行"
Wd.Quit
Set Wd = Nothing
End Sub

ndt3

m_n_j001 发表于 2019-10-23 15:04
以下是找 "职务" 所在的行，拿去改吧
Sub test()
Dim Wd As New Word.Application

Sub test()
Dim Wd As New Word.Application
Dim c%
c = Sheet1.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Column  '最大列号

Wd.Visible = 1
Wd.Documents.Open ThisWorkbook.Path & "\表头位置.doc"

For mb = 4 To c
Wd.ActiveDocument.Tables(1).Select
Wd.Selection.Find.Execute FindText:=Sheet1.Cells(1, mb), Forward:=True
Sheet1.Cells(5, mb).Value = Wd.Selection.Cells(1).RowIndex '在相对应位置第五行填上word符合条件行号
Sheet1.Cells(6, mb).Value = Wd.Selection.Cells(1).ColumnIndex '在相对应位置第六行填上word符合条件行号
'Set Wd = Nothing
Next mb
Wd.Quit
Set Wd = Nothing
End Sub

完美，谢谢老师的指导！长征开始了。第一步完成！
十分感谢！！！

ndt3

m_n_j001 发表于 2019-10-23 15:04
以下是找 "职务" 所在的行，拿去改吧
Sub test()
Dim Wd As New Word.Application

老师，有个bug，没有符合的都返回了“1”