VBA代码优化请求：遍历区域获取各产品组C3单元格最大值

原代码存在的问题 #

• 循环顺序错误：先遍历区域再遍历产品组，导致最终仅保留最后一个区域下的产品组最大值，无法按产品组汇总跨区域数据
• 未处理错误值：C3因无匹配结果报错时，直接赋值会导致代码异常
• 输出逻辑缺陷：仅输出最后一个产品组的结果，且未定义ws1存在引用风险
• 最大值初始化不严谨：未考虑第一个值即为错误的情况

修正后的代码 #

Sub FindMaxPerProductGroup()
    Dim maxDict As Object
    Dim currentValue As Variant
    Dim i As Integer, j As Integer
    Dim regions As Variant
    Dim productGroups As Variant
    Dim ws As Worksheet
    
    ' 指定目标工作表，避免激活其他表时出错
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' 替换为你的工作表名称
    Set maxDict = CreateObject("Scripting.Dictionary")
    
    ' 定义区域和产品组列表
    regions = Array("Region 1", "Region 2", "Region 3")
    productGroups = Array(1, 2, 3, 4, 5)
    
    ' 先遍历产品组，再遍历对应区域，按产品组收集最大值
    For j = LBound(productGroups) To UBound(productGroups)
        Dim currentProduct As Variant
        currentProduct = productGroups(j)
        ' 初始化当前产品组最大值为Excel极小值
        Dim currentMax As Double
        currentMax = -1E+307
        
        For i = LBound(regions) To UBound(regions)
            ws.Range("A1").Value = regions(i)
            ws.Range("A2").Value = currentProduct
            currentValue = ws.Range("C3").Value
            
            ' 跳过错误值，只处理有效数值
            If Not IsError(currentValue) Then
                If currentValue > currentMax Then
                    currentMax = currentValue
                End If
            End If
        Next i
        
        ' 存入字典，区分有有效数据和无有效数据的情况
        If currentMax <> -1E+307 Then
            maxDict(currentProduct) = currentMax
        Else
            maxDict(currentProduct) = "无有效数据"
        End If
    Next j
    
    ' 弹窗输出汇总结果
    Dim resultMsg As String
    resultMsg = "各产品组跨区域C3最大值汇总：" & vbCrLf & vbCrLf
    For Each key In maxDict.Keys
        resultMsg = resultMsg & "产品组 " & key & ": " & maxDict(key) & vbCrLf
    Next key
    MsgBox resultMsg, vbInformation, "最大值汇总"
    
    ' 可选：将结果写入工作表（从E1单元格开始）
    ws.Range("E1").Value = "产品组"
    ws.Range("F1").Value = "跨区域最大值"
    Dim rowNum As Integer
    rowNum = 2
    For Each key In maxDict.Keys
        ws.Range("E" & rowNum).Value = key
        ws.Range("F" & rowNum).Value = maxDict(key)
        rowNum = rowNum + 1
    Next key
End Sub

代码说明 #

• 使用Scripting.Dictionary存储每个产品组的最大值，便于后续读取和输出
• 增加IsError判断，跳过C3的错误值（如#N/A、#VALUE!）
• 调整循环顺序，确保每个产品组遍历所有区域的数值
• 指定工作表对象ws，避免因当前激活表变化导致的引用错误
• 支持两种输出方式：弹窗汇总和写入工作表（可选）

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