VBA实现提取唯一币种列表并计算对应非#N/A最大值

问题场景 #

工作表列结构（从A4开始）：

• A列：收益率曲线
• B列：term
• C列：term points
• D列：current quarter rate
• E列：previous quarter rate
• F列：variance
• G列：variance in %
• H列：currency
• I列：空白
• J列：var tolerance flag
• K列：yc tolerance flag
• L列：待计算的G列绝对值

需求：

1. 计算L列值为对应G列单元格的绝对值（=ABS(G4)），直至G列最后一行；
2. 从H列提取唯一币种列表，放入O4起始区域；
3. 对每个唯一币种，计算其对应L列中非#N/A的最大值，放入P列对应行；
4. 将O、P列结果硬粘贴为数值。

原代码运行后出现所有行重复第一个唯一币种的最大值的问题，以下是修正方案：

修正后的代码 #

Sub GetUniqueCurrenciesAndMax()
    Dim ws As Worksheet
    Dim uniqueCurrencies As Variant
    Dim maxCurrencyValues() As Variant
    Dim i As Long
    Dim lastRow As Long
    Dim dataRangeH As Range
    Dim dataRangeL As Range

    ' 指定目标工作表
    Set ws = ThisWorkbook.Sheets("QRM_YC_QoQ_Checks")

    ' 获取G列最后一行数据的行号
    lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row

    ' 1. 计算L列的绝对值（仅处理有数据的行）
    ws.Range("L4:L" & lastRow).Formula = "=ABS(G4)"
    ' 提前将L列公式转为数值，避免后续计算受公式动态影响
    ws.Range("L4:L" & lastRow).Value = ws.Range("L4:L" & lastRow).Value

    ' 2. 提取H列的唯一币种（仅取有效数据范围，避免整列空值干扰）
    Set dataRangeH = ws.Range("H4:H" & lastRow)
    uniqueCurrencies = Application.WorksheetFunction.Unique(dataRangeH)

    ' 将唯一币种写入O4起始区域
    ws.Range("O4").Resize(UBound(uniqueCurrencies, 1), 1).Value = uniqueCurrencies

    ' 3. 为每个唯一币种计算对应L列的非#N/A最大值
    ReDim maxCurrencyValues(1 To UBound(uniqueCurrencies, 1), 1 To 1)
    Set dataRangeL = ws.Range("L4:L" & lastRow)

    For i = 1 To UBound(uniqueCurrencies, 1)
        ' 使用数组逻辑筛选对应币种且非错误值的最大值
        maxCurrencyValues(i, 1) = Application.Max( _
            Application.IfError( _
                Application.Index(dataRangeL, _
                    Application.Match(uniqueCurrencies(i, 1), dataRangeH, 0)), _
                -1E+307) _
        )
        ' 处理无有效数据的情况，返回空值
        If maxCurrencyValues(i, 1) = -1E+307 Then
            maxCurrencyValues(i, 1) = ""
        End If
    Next i

    ' 将最大值写入P4起始区域
    ws.Range("P4").Resize(UBound(maxCurrencyValues, 1), 1).Value = maxCurrencyValues

    ' 4. 硬粘贴O、P列为数值，固定结果
    ws.Range("O4:P" & ws.Cells(ws.Rows.Count, "O").End(xlUp).Row).Value = _
        ws.Range("O4:P" & ws.Cells(ws.Rows.Count, "O").End(xlUp).Row).Value
End Sub

关键修正点 #

• 避免整列引用：原代码直接引用整列H:H和L:L，会混入大量空值导致Unique返回的数组异常，修正后仅取实际有数据的范围（从第4行到最后一行）。
• 修正循环范围：原代码循环时错误使用UBound(uniqueCurrencies)+1，超出数组实际行数引发索引错误，修正后直接用UBound(uniqueCurrencies, 1)（二维数组第一维的实际行数）作为循环终点。
• 优化最大值计算逻辑：原MaxIfs对错误值处理不够精准，改用Application.Max结合Index/Match和IfError，确保只计算非#N/A的有效值，同时兼容无有效数据的场景。
• 提前固化L列数值：先将L列公式转为数值，避免后续计算受公式动态变化干扰。

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