VBA 判断及标示 ( 有难度 )

On_fire

VBA 判断及标示 ( 有难度 )

*

Sheet1是源资料, 暂时删掉不参加处理的数据

Range (“B18: O31”)是要处理的数据

*

代码逻辑如下,

1. B列开始左到右, 上到下每列取及判断关键值的差

2. 关键值是:左括号(及,逗号前的值

3. 关键值的下一个值比原值少, 多过5 (即-5), 下值标红

4. 关键值的下一个值比原值少, 多过11 (即-11), 下值再标红标粗

*

部分模拟结果在Sheet1(2)

*

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

iu950

附件供参考，下班啦

fzxba

Arr.rar (23.68 KB, 下载次数: 11)

2023-2-21 17:43 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, br(1), Matches(1), i&, j&, Rng As Range
   
    Application.ScreenUpdating = False
    Set Rng = Range("B18:O31")
    With Rng
        .Font.ColorIndex = 0
        .Font.Bold = False
        ar = Rng
    End With
   
    With CreateObject("VBScript.RegExp")
        .Pattern = "(\d+).+\(.*?(\d+).+(\d+)"
        For j = 1 To UBound(ar, 2)
            For i = 2 To UBound(ar)
                If ar(i - 1, j) <> "" And ar(i, j) <> "" Then
                    Set Matches(0) = .Execute(ar(i - 1, j))
                    br(0) = Matches(0)(0).submatches(1)
                    Set Matches(1) = .Execute(ar(i, j))
                    br(1) = Matches(1)(0).submatches(1)
                    If br(0) - br(1) > 5 Then Rng.Cells(i, j).Font.Color = vbRed
                    If br(0) - br(1) > 11 Then Rng.Cells(i, j).Font.Bold = True
                End If
            Next i
        Next j
    End With
   
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

On_fire

gwjkkkkk 发表于 2023-2-21 18:52
Option Explicit
Sub test()
    Dim ar, br(1), Matches(1), i&, j&, Rng As Range

统一回复, 这帖问得好!
大神们用了不同的方式解题, 又是一场神仙打架!