请求协助：跨Excel工作簿参数匹配与自动计算实现

前期准备步骤 #

• 先把两个来源的工作表复制到同一个Excel工作簿中，建议把它们分别重命名为Input1_Sheet和Input2_Sheet（方便后续代码引用）
• 确认两个工作表的第一列都是参数名称（如果不是，你可以调整代码里的列号），数据从第二行开始，第一行是表头

VBA宏代码实现 #

打开Excel，按下Alt + F11打开VBA编辑器，插入一个新模块（右键点击工作簿名称→插入→模块），粘贴下面的代码：

Sub CalculateParamProduct()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim paramDict As Object
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long, j As Long
    Dim paramName As String
    Dim matchFound As Boolean
    
    ' 设置工作表对象，根据你的实际表名修改
    Set ws1 = ThisWorkbook.Worksheets("Input1_Sheet")
    Set ws2 = ThisWorkbook.Worksheets("Input2_Sheet")
    
    ' 创建字典存储Input2的参数与对应值（键：参数名，值：对应行号）
    Set paramDict = CreateObject("Scripting.Dictionary")
    paramDict.CompareMode = vbTextCompare ' 忽略大小写，应对名称大小写差异
    
    ' 遍历Input2_Sheet，填充字典
    lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow2
        paramName = Trim(ws2.Cells(i, 1).Value)
        If paramName <> "" Then
            ' 处理名称略有差异的情况：模糊匹配（比如包含关键词）
            ' 如果需要精确匹配，直接用paramDict(paramName) = i即可
            matchFound = False
            For Each key In paramDict.Keys
                If InStr(1, paramName, key, vbTextCompare) > 0 Or InStr(1, key, paramName, vbTextCompare) > 0 Then
                    matchFound = True
                    Exit For
                End If
            Next key
            If Not matchFound Then
                paramDict.Add paramName, i
            End If
        End If
    Next i
    
    ' 遍历Input1_Sheet，匹配参数并计算乘积
    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    ' 在Input1_Sheet最后添加"Output"表头
    ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Offset(0, 1).Value = "Output"
    Dim outputCol As Long
    outputCol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    
    For i = 2 To lastRow1
        paramName = Trim(ws1.Cells(i, 1).Value)
        If paramName <> "" Then
            matchFound = False
            ' 先尝试精确匹配
            If paramDict.Exists(paramName) Then
                j = paramDict(paramName)
                matchFound = True
            Else
                ' 精确匹配失败，尝试模糊匹配
                For Each key In paramDict.Keys
                    If InStr(1, paramName, key, vbTextCompare) > 0 Or InStr(1, key, paramName, vbTextCompare) > 0 Then
                        j = paramDict(key)
                        matchFound = True
                        Exit For
                    End If
                Next key
            End If
            
            If matchFound Then
                ' 假设Input1的数值在第二列，Input2的数值在第二列，根据实际调整
                If IsNumeric(ws1.Cells(i, 2).Value) And IsNumeric(ws2.Cells(j, 2).Value) Then
                    ws1.Cells(i, outputCol).Value = ws1.Cells(i, 2).Value * ws2.Cells(j, 2).Value
                Else
                    ws1.Cells(i, outputCol).Value = "数值无效"
                End If
            Else
                ws1.Cells(i, outputCol).Value = "未找到匹配参数"
            End If
        Else
            ws1.Cells(i, outputCol).Value = "参数名为空"
        End If
    Next i
    
    MsgBox "计算完成！", vbInformation
    Set paramDict = Nothing
    Set ws1 = Nothing
    Set ws2 = Nothing
End Sub

代码关键说明 #

• 字典的使用：用Scripting.Dictionary存储Input2的参数，比VLOOKUP快得多，尤其是数据量大的时候，而且支持忽略大小写的匹配
• 模糊匹配逻辑：代码里加入了InStr函数来处理名称略有差异的情况（比如“参数A”和“参数_A”、“参数A（新版）”这类相似名称），如果只需要精确匹配，你可以删掉模糊匹配的部分，直接用精确匹配
• 灵活调整列号：代码里默认参数名在第一列，数值在第二列，你可以根据自己的表格结构修改Cells(i, 2)里的数字
• 错误处理：对空参数名、无效数值、未匹配到的情况都做了提示，方便你排查问题

使用方法 #

1. 按照前期准备的要求整理好工作表
2. 修改代码里的工作表名称（Input1_Sheet和Input2_Sheet）为你实际的表名
3. 调整代码里的数值列号（如果你的input1和input2不在第二列）
4. 按下F5运行宏，或者回到Excel界面，通过“开发工具”→“宏”选择CalculateParamProduct运行

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