无需打开工作簿，通过VBA从关闭的列表工作簿导入对应值

完全可以实现不用打开“列表”工作簿，同时高效匹配拉丁种名对应的俗名，下面是针对你的需求写的完整代码，附带详细注释，适合VBA新手参考：

核心思路 #

1. 用ADO技术直接读取关闭状态下的Excel工作簿数据，避免打开文件的开销
2. 把拉丁种名-俗名对应关系存入字典，数据量大时查找效率远高于循环匹配
3. 在原有导出Word的逻辑中，增加俗名查找步骤，插入到对应书签位置

完整代码 #

Sub 导出树木数据到Word并匹配俗名()
    Dim wdApp As Object, wdDoc As Object
    Dim 调查数据工作簿 As Workbook, 调查数据工作表 As Worksheet
    Dim 列表文件路径 As String, 字典 As Object
    Dim 拉丁种名 As String, 对应俗名 As String
    Dim 当前行 As Long, 最后行 As Long
    
    ' --------------------------
    ' 1. 初始化设置
    ' --------------------------
    Set 调查数据工作簿 = ThisWorkbook
    Set 调查数据工作表 = 调查数据工作簿.Sheets("Sheet1") ' 改成你的调查数据工作表名
    列表文件路径 = "C:\你的列表工作簿路径\树种列表.xlsx" ' 改成你的列表工作簿实际路径
    
    ' 创建字典用于存储拉丁种名和俗名的对应关系
    Set 字典 = CreateObject("Scripting.Dictionary")
    字典.CompareMode = vbTextCompare ' 不区分大小写匹配（可选，根据需求调整）
    
    ' --------------------------
    ' 2. 读取关闭状态下的列表工作簿数据到字典
    ' --------------------------
    Dim adoConn As Object, adoRS As Object
    Set adoConn = CreateObject("ADODB.Connection")
    Set adoRS = CreateObject("ADODB.Recordset")
    
    ' 设置ADO连接字符串（适配xlsx格式）
    adoConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                 "Data Source=" & 列表文件路径 & ";" & _
                 "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    
    ' 读取列表工作簿的Sheet1数据（假设拉丁种名在A列，俗名在B列，表头为"拉丁种名"、"俗名"）
    adoRS.Open "SELECT 拉丁种名, 俗名 FROM [Sheet1$]", adoConn
    
    ' 循环读取数据存入字典
    Do While Not adoRS.EOF
        拉丁种名 = adoRS.Fields("拉丁种名").Value
        对应俗名 = adoRS.Fields("俗名").Value
        If Not 字典.Exists(拉丁种名) Then
            字典.Add 拉丁种名, 对应俗名
        End If
        adoRS.MoveNext
    Loop
    
    ' 关闭ADO连接
    adoRS.Close
    adoConn.Close
    Set adoRS = Nothing
    Set adoConn = Nothing
    
    ' --------------------------
    ' 3. 初始化Word并打开模板
    ' --------------------------
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True ' 调试时设为True，正式运行可以改成False后台执行
    Set wdDoc = wdApp.Documents.Open("C:\你的Word模板路径\树木调查模板.docx") ' 改成你的模板路径
    
    ' --------------------------
    ' 4. 循环处理每行调查数据，插入Word书签
    ' --------------------------
    最后行 = 调查数据工作表.Cells(Rows.Count, "A").End(xlUp).Row ' 假设拉丁种名在A列
    For 当前行 = 2 To 最后行 ' 从第2行开始，跳过表头
        拉丁种名 = 调查数据工作表.Cells(当前行, "A").Value
        
        ' 查找对应俗名，找不到则显示"未匹配到俗名"
        If 字典.Exists(拉丁种名) Then
            对应俗名 = 字典(拉丁种名)
        Else
            对应俗名 = "未匹配到俗名"
        End If
        
        ' 插入到Word对应书签位置（假设书签名为"拉丁种名"和"俗名"）
        On Error Resume Next ' 防止书签不存在报错
        wdDoc.Bookmarks("拉丁种名").Range.Text = 拉丁种名
        wdDoc.Bookmarks("俗名").Range.Text = 对应俗名
        On Error GoTo 0
        
        ' 可选：如果需要批量生成多个Word文档，这里添加保存新文档的代码
        ' wdDoc.SaveAs "C:\保存路径\树木调查_" & 当前行 & ".docx"
    Next 当前行
    
    ' --------------------------
    ' 5. 收尾清理
    ' --------------------------
    ' wdDoc.Close SaveChanges:=True ' 若需要保存模板修改则启用
    ' Set wdDoc = Nothing
    ' wdApp.Quit
    ' Set wdApp = Nothing
    Set 字典 = Nothing
    Set 调查数据工作表 = Nothing
    Set 调查数据工作簿 = Nothing
    
    MsgBox "数据导出完成！"
End Sub

注意事项 #

• 替换代码中的文件路径：包括列表工作簿路径、Word模板路径，确保路径正确
• 确认工作表名和列对应：如果你的列表工作簿拉丁种名/俗名不在A/B列，或者工作表名不是Sheet1，修改SQL语句中的[Sheet1$]和字段名
• 书签名称要和Word模板中的书签完全一致，区分大小写
• 如果数据量极大，ADO读取的方式比其他方法效率更高，不会出现卡顿

内容的提问来源于stack exchange，提问作者Flaky