Excel VBA判断数值处于E、F列区间时复制对应J列值到A1求助

首次尝试代码问题 #

• 变量类型错误：将数值型的对比值3.61定义为String字符串类型，数值比较时会出现类型不匹配错误
• 筛选逻辑写反：需求是3.61 > E列值 且 3.61 < F列值，对应筛选条件应为E列小于3.61、F列大于3.61，原代码的筛选条件完全写反
• 缺少核心逻辑：仅完成了筛选操作，没有写筛选后提取J列值赋值到A1的代码

第二次尝试代码问题 #

• 语法错误：If判断语句没有对应的End If闭合，编译器无法正确识别代码结构，直接触发Next Without For编译错误
• 数组索引错误：单独读取E列到vColT数组时，数组为单列结构，仅能通过vColT(行索引,1)取值，原代码用vColT(i,5)完全无法取到正确值
• 赋值逻辑写反：需求是将J列值写入A1，原代码是将A1的值批量写入J列所有行
• 同样存在变量类型错误，将数值对比值定义为字符串类型

提供两个实现版本，可根据使用场景选择：

循环遍历版本（逻辑清晰，适合数据量较小的场景） #

Sub MatchAndAssign()
    Dim targetVal As Double
    Dim lastRow As Long
    Dim i As Long
    
    targetVal = 3.61
    
    With Worksheets("Sheet1")
        ' 获取E列最后一行有数据的行号
        lastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
        
        ' 遍历第7行到最后一行，可根据实际表头行数调整起始行
        For i = 7 To lastRow
            ' 匹配条件：3.61大于E列值、小于F列值
            If .Cells(i, "E").Value < targetVal And .Cells(i, "F").Value > targetVal Then
                ' 将当前行J列值赋值给A1
                .Range("A1").Value = .Cells(i, "J").Value
                ' 仅需第一个匹配结果就保留下面这行，需要最后一个匹配结果就删除
                Exit For
            End If
        Next i
    End With
End Sub

筛选版本（运行速度快，适合数据量较大的场景） #

Sub FilterAndAssign()
    Dim targetVal As Double
    Dim lastRow As Long
    Dim filterRng As Range
    
    targetVal = 3.61
    
    With Worksheets("Sheet1")
        ' 清除已有筛选
        If .AutoFilterMode Then .AutoFilterMode = False
        
        lastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
        Set filterRng = .Range("A6:V" & lastRow)
        
        ' 按条件筛选
        filterRng.AutoFilter Field:=5, Criteria1:="<" & targetVal
        filterRng.AutoFilter Field:=6, Criteria1:=">" & targetVal
        
        ' 无匹配结果时跳过赋值避免报错
        On Error Resume Next
        .Range("A1").Value = .Range("J7:J" & lastRow).SpecialCells(xlCellTypeVisible).Cells(1).Value
        On Error GoTo 0
        
        ' 清除筛选恢复原始数据展示
        .AutoFilterMode = False
    End With
End Sub

如果需要将所有匹配行的J列值拼接后写入A1，或者按顺序写入A列多行，可以修改对应赋值逻辑，上述代码默认取第一个匹配到的结果写入A1。

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