现在的位置: 首页 > 综合 > 正文

vba为每行中最小值单元格添加背景颜色

2013年10月10日 ⁄ 综合 ⁄ 共 1440字 ⁄ 字号 评论关闭

Sub laolao()
Dim rols, role, cols, cole '根据情况修改这四个参数
rols = 2 '数据开始行
role = 20 '数据结束行数
cols = 2 '数据开始列
cole = 20 '数据结束列数
   
    Cells.Select '选中全部并清除背景
    Selection.Interior.ColorIndex = xlNone
    Range("A1").Select

    Do While (rols < role) '当行数大于最大行时退出循环
        Dim colIndex, tempValue 'colindex记录列号,tempValue记录最小值
        colIndex = cols
        tempValue = 999999999 ' Cells(rols, cols).Value为防止第一列为空值不处理的问题,所以为初始值初始化为999999999
        tempCol = colIndex 'tempCol记录最小值的列号
       
        Do While (colIndex < cole) '当列数大于最列退出循环
            If (Cells(rols, colIndex).Value < tempValue And Cells(rols, colIndex).Value <> "") Then '当前单元格的值小于前面的最小值,且不等于空
           
                tempValue = Cells(rols, colIndex).Value '当前单元格的值小于前面的最小值,就把最小值设为当前列的值
                tempCol = colIndex '记录最小值的列号
           
            End If
               colIndex = colIndex + 1
        Loop
        If (Cells(rols, tempCol).Value <> "") Then '但最小值所在的单元格等于空,不加背景色
            Cells(rols, tempCol).Select '选中最小值的单元格
            With Selection.Interior
                     .Color = 65535 '着色
            End With
        End If
       
        colIndex = cols
        Do While (colIndex < cole) '本循环为全部等于最小值的单元格着色,当列数大于最列退出循环
            If (Cells(rols, colIndex).Value = tempValue And Cells(rols, colIndex).Value <> "") Then '当前单元格的值小于前面的最小值,且不等于空
           
                Cells(rols, colIndex).Select '选中最小值的单元格
                With Selection.Interior
                     .Color = 65535
                End With
           
            End If
               colIndex = colIndex + 1
        Loop
        rols = rols + 1
    Loop

End Sub

抱歉!评论已关闭.