找到每一行的最小值,将最小值的单元格背景变成绿色，并将最小值数值放入J栏对应的位置

sxbjzjf110

gwjkkkkk

Option Explicit
Sub TEST5()
    Dim ar, i&, j&, vNum, dic As Object
   
    Set dic = CreateObject("Scripting.Dictionary")
    With [B2:j10]
        .Interior.ColorIndex = xlNone
        ar = .Value
        For i = 1 To UBound(ar)
            dic.RemoveAll
            For j = 1 To UBound(ar, 2) - 1
                If ar(i, j) <> 0 Then dic(ar(i, j)) = j
            Next j
            vNum = Application.Min(dic.keys)
            .Cells(i, dic(vNum)).Interior.Color = vbGreen
            .Cells(i, UBound(ar, 2)) = vNum
        Next i
    End With
   
    Set dic = Nothing
    Beep
End Sub

lizhipei78

全党 发表于 2023-5-12 15:20
Sub shishi()
Set dic = CreateObject("scripting.dictionary")
Cells.Interior.ColorIndex = xlNone

你这个是最好理解的，根据楼主的案例，有必要把0先替换成其它的，这样子也比较好判断

lizhipei78

hongshan2019 发表于 2023-5-12 15:00
=MIN(IF(B2:I2>0,B2:I2))，三键找最小值，结合条件可以也可以实现

=SMALL(IF(B2:I2=0,9E+307,B2:I2),1)
我用了这个，想不到还是你这个更简单
条件格式
=B2:I2=$J2

佳能lT搬砖着

1.   Dim lastRow As Long
   
2.     Dim minVal As Double
   
3.     Dim minCell As Range
   
4.    
   
5.     lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row '获取B列最后一行的行号
   
6.    
   
7.     For i = 2 To lastRow '从第2行开始循环，因为第1行是表头
   
8.         minVal = WorksheetFunction.Min(Range("C" & i & ":I" & i)) '获取当前行C到I列的最小值
   
9.         Set minCell = Range("C" & i & ":I" & i).Find(what:=minVal) '找到最小值所在的单元格
   
10.         
    
11.         '将最小值单元格的背景色设置为绿色
    
12.         minCell.Interior.Color = RGB(0, 255, 0)
    
13.         
    
14.         '将最小值放入J列对应的位置
    
15.         Range("J" & i).Value = minVal
    
16.     Next i

复制代码