Excel宏需求：从单元格复制路径并写入查找公式

需求背景 #

当前工作簿包含两个工作表：

• Items表：
  • A列：每行设置"Go Button"按钮，用于触发宏
  • B列：项目ID
  • C列：经办人缩写
  • D列：通过公式=INDEX(Members!$C:$C,MATCH(Items!$C2,Members!$B:$B,0))自动获取对应经办人的工作量文件路径
  • E及后续列：需要生成跨工作簿的LOOKUP公式，从对应经办人文件中提取数据（示例公式：=INDEX('E:\Team\Blue\Individial Files[John Doe Workload.xlsx]Sheet1'!$B:$B,MATCH($B2,'E:\Team\Blue\Individial Files[John Doe Workload.xlsx]Sheet1'!$A:$A,0))）
• Members表：
  • A列：经办人姓名
  • B列：经办人缩写
  • C列：经办人对应的工作量文件完整路径

现有问题：使用INDIRECT函数实现路径引用时，必须打开所有约50个工作量文件，且无法适配持续新增的条目和变更的经办人。需要通过宏实现：点击对应行的Go按钮后，自动读取该行D列的路径，生成E及后续列的LOOKUP公式。

补充：工作量文件的Sheet1中，A列为项目ID，B列为Start Date，C列为Due Date，D列为Status Code。

VBA宏代码实现 #

Sub GenerateLookupFormulas()
    Dim targetRow As Long
    Dim filePath As String
    Dim formulaPrefix As String
    Dim wsItems As Worksheet
    
    ' 指向Items工作表
    Set wsItems = ThisWorkbook.Worksheets("Items")
    
    ' 获取当前点击按钮所在的行号
    targetRow = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
    
    ' 读取D列的文件路径
    filePath = wsItems.Cells(targetRow, "D").Value
    
    ' 检查路径是否为空
    If filePath = "" Then
        MsgBox "未获取到有效文件路径，请检查C列经办人缩写是否正确", vbExclamation
        Exit Sub
    End If
    
    ' 格式化路径为公式所需的格式：'路径\[文件名.xlsx]Sheet1'!
    formulaPrefix = "'" & Left(filePath, InStrRev(filePath, "\")) & "[" & Mid(filePath, InStrRev(filePath, "\") + 1) & "]Sheet1'!"
    
    ' 生成E列（Start Date）公式
    wsItems.Cells(targetRow, "E").Formula = _
        "=INDEX(" & formulaPrefix & "$B:$B,MATCH($B" & targetRow & "," & formulaPrefix & "$A:$A,0))"
    
    ' 生成F列（Due Date）公式
    wsItems.Cells(targetRow, "F").Formula = _
        "=INDEX(" & formulaPrefix & "$C:$C,MATCH($B" & targetRow & "," & formulaPrefix & "$A:$A,0))"
    
    ' 生成G列（Status Code）公式
    wsItems.Cells(targetRow, "G").Formula = _
        "=INDEX(" & formulaPrefix & "$D:$D,MATCH($B" & targetRow & "," & formulaPrefix & "$A:$A,0))"
    
    ' 如果需要更多列，继续按此格式添加即可
    MsgBox "公式已生成完成", vbInformation
End Sub

代码说明 #

1. 获取目标行：通过Application.Caller获取点击的按钮对象，再通过TopLeftCell.Row定位到按钮所在的行，确保宏能处理任意行的按钮点击。
2. 路径格式化：将D列的完整文件路径（如E:\Team\Blue\Individial Files\John Doe Workload.xlsx）转换为Excel跨工作簿公式所需的格式：'E:\Team\Blue\Individial Files\[John Doe Workload.xlsx]Sheet1'!。
3. 公式生成：针对E、F、G列分别生成对应字段的INDEX/MATCH公式，无需打开目标文件即可正常读取数据（Excel会在需要时自动按需加载外部文件数据）。
4. 异常处理：如果D列路径为空，弹出提示避免生成无效公式。

使用步骤 #

1. 打开VBA编辑器（按Alt + F11），插入新模块（右键工作簿→插入→模块），将上述代码粘贴到模块中。
2. 返回Items工作表，为每行的Go按钮指定宏：右键按钮→指定宏→选择GenerateLookupFormulas并确认。

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