Excel VBA需求：对比两工作表值并返回最接近/相同值所在整行

需求说明 #

• 两个工作表：Worksheet 1（数据输入表）、Worksheet 2（全量数据表）
• 点击「Estimate」按钮时，将Worksheet 1中C6单元格的输入值，与Worksheet 2的G11:G83区域对比：
  1. 优先返回完全匹配值所在的整行数据
  2. 无完全匹配时，返回最接近值所在的整行数据

原代码问题分析 #

原代码仅实现了「查找完全匹配值并返回行号」的逻辑，存在以下局限：

• 未处理「无完全匹配时找最接近值」的核心需求
• 仅返回匹配行号，未复制整行数据到目标区域
• 未明确指定工作表对象，可能导致数据写入位置错误

修正后的VBA代码 #

Sub CompareAndReturnRow()
    Dim wsInput As Worksheet, wsData As Worksheet
    Dim inputVal As Double, closestVal As Double
    Dim searchRange As Range, cell As Range
    Dim matchRow As Long, closestRow As Long
    Dim diff As Double, minDiff As Double
    
    ' 初始化工作表对象，避免引用错误
    Set wsInput = ThisWorkbook.Worksheets(1)
    Set wsData = ThisWorkbook.Worksheets(2)
    Set searchRange = wsData.Range("G11:G83")
    
    ' 清空之前的结果
    wsInput.Range("I6:XFD6").ClearContents ' 清空整行，可根据实际列数调整XFD
    
    ' 获取输入值，确保是数值类型
    If IsNumeric(wsInput.Range("C6").Value) Then
        inputVal = wsInput.Range("C6").Value
    Else
        MsgBox "请输入有效数值"
        Exit Sub
    End If
    
    ' 第一步：查找完全匹配值
    Set cell = searchRange.Find(What:=inputVal, LookIn:=xlValues, LookAt:=xlWhole)
    If Not cell Is Nothing Then
        matchRow = cell.Row
        ' 复制匹配行到Worksheet 1的I6起始位置
        wsData.Rows(matchRow).Copy Destination:=wsInput.Range("I6")
        Exit Sub
    End If
    
    ' 第二步：无完全匹配时，查找最接近值
    minDiff = 999999 ' 初始化极大值作为最小差值基准
    For Each cell In searchRange
        If IsNumeric(cell.Value) Then
            diff = Abs(inputVal - cell.Value)
            ' 更新最小差值及对应行号
            If diff < minDiff Then
                minDiff = diff
                closestVal = cell.Value
                closestRow = cell.Row
            End If
        End If
    Next cell
    
    ' 复制最接近值所在行到目标区域
    wsData.Rows(closestRow).Copy Destination:=wsInput.Range("I6")
    MsgBox "无完全匹配值，已返回最接近值：" & closestVal
End Sub

代码说明 #

• 明确指定工作表对象，避免跨表引用错误
• 先执行完全匹配查找，找到则直接复制整行
• 无匹配时遍历目标区域，通过计算绝对值差值定位最接近值
• 清空目标区域旧数据，将匹配/最接近行完整复制到Worksheet 1的I6起始位置
• 加入输入值有效性判断，避免非数值输入报错

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