VBA 判断及标示

On_fire

VBA 判断及标示

*

Sheet1是源数据, 1~8行是标题行, AB两列是标题列

单元格[ C9 ]往右到N列, 每一列是要判断的区域, 往下行数是变量

注: 其它区域(列)有数据, 暂时删掉

*

代码逻辑如下,

1.      [C9]~N列, 每一列找出最小的4个数字 ( =  最小的4个值, 同值当一个 )

2.      分别标不同的底色

*

模拟结果在Sheet1(2)

*

恳请大神, 老师出手帮忙…谢谢!!!

zjzyj

附件供参考。

筛选取前４个应该也可以的

On_fire

zjzyj 发表于 2023-3-24 16:40
附件供参考。

筛选取前４个应该也可以的

谢谢老师,
试了几次标示效果, 好像是每列的颜色是随机的?

liulang0808

TLL.zip (21.17 KB, 下载次数: 8)

2023-3-25 07:35 上传

点击文件名下载附件

On_fire

liulang0808 发表于 2023-3-25 07:35

版主,
早上好! 感谢您…

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, i&, j&, n&, Rng As Range, strJoin$, dic As Object
    Set Rng = Intersect(ActiveSheet.UsedRange, [C9].Resize(8888).Resize(, 8888))
    Set dic = CreateObject("Scripting.Dictionary")
    With Rng
        ar = .Value
        .Interior.ColorIndex = xlNone
        For j = 1 To UBound(ar, 2)
            dic.RemoveAll
            strJoin = ""
            For i = 1 To UBound(ar)
                If ar(i, j) <> "" And IsNumeric(ar(i, j)) Then
                    dic(ar(i, j)) = ""
                End If
            Next i
            If dic.Count <> 0 Then
                n = IIf(dic.Count >= 4, 4, dic.Count)
                For i = 1 To n
                    strJoin = strJoin & "," & WorksheetFunction.Small(dic.keys, i)
                    dic(WorksheetFunction.Small(dic.keys, i)) = i + 2
                Next i
                strJoin = strJoin & ","
                For i = 1 To UBound(ar)
                    If InStr(strJoin, "," & ar(i, j) & ",") Then
                        .Cells(i, j).Interior.ColorIndex = dic(ar(i, j))
                    End If
                Next i
            End If
        Next j
    End With
End Sub

gwjkkkkk

参与一下。。。