到Excel提取相应信息填到Word中

zhangingu · 发表于 2018-1-20 16:31

本帖最后由 zhangingu 于 2018-1-20 16:34 编辑

要求：根据Word中每页的学号（如L440513201001160041）（学号是唯一的）自动到Excel提取相对应的家长姓名，填到Word的“家长签名”右边。如果两列都有数据，则签两个，如果只有一列数据，则签到有数据下面（只签一个）。

duquancai · 发表于 2018-1-20 17:10

跟下面这个链接的问题完全类似，4楼已经提供了完全类似的代码，自己动手修改一下代码不就行了吗？？？？？
http://club.excelhome.net/thread-1379179-1-1.html

daibao88 · 发表于 2018-1-20 20:34

相似度这么高

zhangingu · 发表于 2018-1-21 08:36

我看不懂，麻烦大侠帮我改一下，万分谢谢！

qcw911 · 发表于 2018-1-22 08:34

用Mark方法很快的

zhangingu · 发表于 2018-1-22 09:26

qcw911 发表于 2018-1-22 08:34
用Mark方法很快的

Mark方法是什么

zhangingu · 发表于 2018-1-22 09:34

Sub 家长签名()
Dim doc As Document, sql$, conn As Object, pf$, arr, d As Object, cn&, r As Range, sr$
Set doc = ActiveDocument
If doc.Tables.Count < 3 Then Exit Sub
pf = doc.Path & "\家长信息.xls"
sql = "select 学生姓名,家长姓名 from [" & pf & "].[Sheet1$] where 学生姓名 is not null"
Set conn = CreateObject("adodb.connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;extended properties=EXCEL 12.0;data source=" & pf
arr = conn.Execute(sql).GetRows
Set d = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(arr, 2)
      d(arr(0, i)) = arr(1, i)
Next
For i = 1 To doc.Tables.Count Step 3
      cn = doc.Tables(i + 1).Range.Cells.Count
      Set r = doc.Tables(i).Range.Cells(2).Range
      r.End = r.End - 1: sr = r.Text
      doc.Tables(i + 1).Range.Cells(cn).Range = d(sr)
      doc.Tables(i + 1).Range.Cells(cn - 2).Range = d(sr)
Next
End Sub

zhangingu · 发表于 2018-1-22 09:35

请高人帮帮修改一下

xzgxzgxzg2020 · 发表于 2020-4-16 16:36

忠

于找到大神门了

走过路过嫑错过 · 发表于 2020-4-20 11:16

只有想不到，没有做不到。可惜自己功力不够

		自动登录	找回密码
密码			免费注册

[求助] 到Excel提取相应信息填到Word中