基于A/B/C三列条件求D列最小值的VBA代码：F列结果异常

现有VBA代码旨在根据A、B、C三列的组合条件，查找对应D列的最小值并写入E列，目前E列功能看似正常，但F列出现重复且错误的结果。原代码如下：

Sub FindLowestValuewith3criteria()

Dim lastRow As Long
Dim ws As Worksheet
Dim dict As Object
Dim rng As Range
Dim cell As Range
Dim key As String
Dim minValue As Double

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set ws = ThisWorkbook.Sheets("Orbit") ' 替换为实际工作表名称
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set rng = ws.Range("A2:D" & lastRow) ' 假设表头在第1行
rng.Value = ws.Range("A2:D" & lastRow).Value


Set dict = CreateObject("Scripting.Dictionary")

For Each cell In rng
    key = cell.Value & "_" & cell.Offset(0, 1).Value & "_" & cell.Offset(0, 2).Value ' 将三个条件值组合作为字典键
    
    If Not dict.exists(key) Then ' 检查字典中是否已存在该键
        dict.Add key, cell(1, 4) ' 若不存在，将D列值作为初始值添加
    Else
        minValue = dict(key) ' 获取该键当前的最小值
        If cell(1, 4) < minValue Then ' 比较当前值与最小值
            dict(key) = cell(1, 4) ' 若当前值更小则更新最小值
        End If
    End If
Next cell

' 将最小值输出到E列
ws.Range("E2:E" & lastRow).ClearContents ' 清除之前的结果
For Each cell In rng
    key = cell(1, 1) & "_" & cell(1, 2) & "_" & cell(1, 3)
    cell(1, 5) = dict(key) ' 在E列输出最小值
Next cell

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub

问题分析 #

1. 核心遍历逻辑错误：原代码使用For Each cell In rng遍历A2:D区域的每个单元格，而非按行遍历。这会导致同一行的A/B/C/D单元格被重复处理，生成大量冗余的key，虽然可能巧合让E列结果看似正常，但会导致字典数据存在隐性错误，进而影响依赖E列的F列（比如F列有公式或其他关联逻辑）。
2. 单元格引用错误：当遍历到非A列的单元格时，cell(1,4)的相对引用会指向错误的列（例如遍历B2时，cell(1,4)实际指向E2而非D2），这会导致字典中存储的最小值并非真实的D列数据。
3. F列无直接操作：原代码未涉及F列的修改，F列异常大概率是其依赖E列数据，而E列的隐性错误传递导致了F列结果异常。

修复后的代码 #

Sub FindLowestValuewith3criteria()
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim dict As Object
    Dim rng As Range
    Dim row As Range
    Dim key As String
    Dim currentDValue As Double

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set ws = ThisWorkbook.Sheets("Orbit")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set rng = ws.Range("A2:D" & lastRow)

    Set dict = CreateObject("Scripting.Dictionary")

    ' 按行遍历，确保每个组合条件仅处理一次
    For Each row In rng.Rows
        key = row.Cells(1, 1).Value & "_" & row.Cells(1, 2).Value & "_" & row.Cells(1, 3).Value
        currentDValue = row.Cells(1, 4).Value

        If Not dict.exists(key) Then
            dict.Add key, currentDValue
        Else
            If currentDValue < dict(key) Then
                dict(key) = currentDValue
            End If
        End If
    Next row

    ' 写入E列最小值
    ws.Range("E2:E" & lastRow).ClearContents
    For Each row In rng.Rows
        key = row.Cells(1, 1).Value & "_" & row.Cells(1, 2).Value & "_" & row.Cells(1, 3).Value
        row.Cells(1, 5).Value = dict(key)
    Next row

    ' 若F列有独立逻辑，需检查其代码/公式是否正确
    ' 示例：如果F列是E列的计算值，确保公式引用无误
    ' ws.Range("F2:F" & lastRow).Formula = "=E2*1.1" ' 根据实际需求调整

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

修复说明 #

• 改为按行遍历（For Each row In rng.Rows），确保每个A/B/C组合仅被处理一次，避免冗余计算和错误赋值。
• 使用row.Cells(1, N)明确引用每行的对应列，消除相对引用导致的取值错误。
• 修复E列的隐性错误后，若F列依赖E列数据，其结果应自动恢复正常；若F列有独立VBA逻辑，需检查是否存在类似的遍历或键值生成错误。

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