VBA编写的INDEX/MATCH动态公式报错，求修复方案

我编写了一段VBA宏，用于生成动态INDEX/MATCH公式，从「US acq_CUSIP data」工作表提取数据并输出到「Acquirer_ETR」工作表（代码中为ws_output）。其中ws_input对应「MA_ExportFiltered_RawData」工作表，该表包含R43:R3223区域的企业列表及日历年数据。运行宏时出现「Application-defined or object-defined error」错误，推测是生成的INDEX公式存在问题，求修复方案。

原代码如下：

Sub fetching_acq_data_compustat()

Dim ws_input As Worksheet
Dim strTkr As String
Dim rngTkr As Range
Dim c As Range

Dim ws_output As Worksheet
Dim strTaxPaid As String
Dim StrPretaxIncome As String
Dim strSpecItem As String
Dim strTkrCell As String
Dim Dated As String
Dim strDatedCell As String


Set ws_input = ThisWorkbook.Sheets("MA_ExportFiltered_RawData")
Set ws_output = ThisWorkbook.Sheets("Acquirer_ETR")


ws_output.Activate

With ws_output
    Set rngTkr = .Range("R43:R3223")
    i = 1
    For Each c In rngTkr
    
        strTkrCell = c.Address
        
        k = 14
        If k < 16 Then
        Dated = c.Offset(0, k).Address
        strDatedCell = Dated
        
        ws_output.Range("A1").Offset(2, 0).Value = c.Offset(0, 14).Value
        
        ActiveCell.Offset(0, i).Value = "=INDEX( 'US acq_CUSIP data'!$A$3:$AJ$77388" & ";" & "MATCH(1; ('US acq_CUSIP data'!$I$3:$I$77388=" & "MA_ExportFiltered_RawData!" & strTkrCell & ")*('US acq_CUSIP data'!$C$3:$C$77388=" & "MA_ExportFiltered_RawData!" & strDatedCell & ");0); 26)"
        
        ActiveCell.Offset(-1, 0).Value = 26
        
        ActiveCell.Offset(-1, 0).Value = c.Value
        
        k = k + 1
        
        End If
        
    Next
End With
    

End Sub

问题分析与修复方案 #

1. 公式分隔符错误

Excel公式的参数分隔符依赖系统区域设置，默认英文环境使用**逗号（,）**而非分号（;）。原代码中用分号分隔公式参数，会导致公式语法错误，触发运行时错误。

修复：将公式字符串中的所有;替换为,。

2. ActiveCell引用混乱

代码中依赖ActiveCell定位目标单元格，但ws_output.Activate后ActiveCell的位置不确定，容易导致引用错误。应直接使用明确的单元格引用，避免依赖激活状态。

修复：用ws_output的具体单元格偏移定位，替代ActiveCell。

3. 数据源引用错误

原代码中strTkrCell和strDatedCell取的是ws_output（Acquirer_ETR）里的单元格地址，但公式里却指向MA_ExportFiltered_RawData工作表，这属于引用错位，会导致MATCH无法匹配到正确数据。

修复：从ws_input（MA_ExportFiltered_RawData）中获取对应企业和日期的单元格地址。

4. 循环逻辑冗余

k = 14在循环内部初始化，且If k < 16只会执行一次，逻辑无意义，需移除冗余代码或调整循环逻辑。

修复后的完整代码 #

Sub fetching_acq_data_compustat()
    Dim ws_input As Worksheet
    Dim ws_output As Worksheet
    Dim rngTkr As Range
    Dim c As Range
    Dim targetRow As Long
    Dim strTkrCell As String
    Dim strDatedCell As String
    
    ' 初始化工作表对象
    Set ws_input = ThisWorkbook.Sheets("MA_ExportFiltered_RawData")
    Set ws_output = ThisWorkbook.Sheets("Acquirer_ETR")
    
    ' 设置输出起始行（根据需求调整，这里从第3行开始）
    targetRow = 3
    
    ' 遍历输入表的企业列表区域
    Set rngTkr = ws_input.Range("R43:R3223")
    For Each c In rngTkr
        ' 跳过空单元格
        If c.Value <> "" Then
            ' 获取输入表中对应企业和日期的单元格地址（带工作表引用）
            strTkrCell = "'" & ws_input.Name & "'!" & c.Address
            strDatedCell = "'" & ws_input.Name & "'!" & c.Offset(0, 14).Address
            
            ' 写入日期到输出表A列
            ws_output.Cells(targetRow, "A").Value = c.Offset(0, 14).Value
            ' 写入企业标识到输出表B列
            ws_output.Cells(targetRow, "B").Value = c.Value
            ' 生成正确的INDEX/MATCH公式并写入C列
            ws_output.Cells(targetRow, "C").Formula = _
                "=INDEX('US acq_CUSIP data'!$A$3:$AJ$77388, MATCH(1, ('US acq_CUSIP data'!$I$3:$I$77388=" & strTkrCell & ")*('US acq_CUSIP data'!$C$3:$C$77388=" & strDatedCell & "), 0), 26)"
            
            targetRow = targetRow + 1
        End If
    Next c
End Sub

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