简体   繁体   中英

How to highlight temperature strings with a regex in excel VBA

When the contents of a cell changes, some strings are highlighted. This part I got working already. Now I added a regex to highlight strings that contain a temperature as well (ie 13° or 10°-25°) This part however does not work (no error but just no output)

This is what I have so far. This all works except for this part ( blue2Items = "(\\d{1,2}°-\\d{1,2}°|\\d{1,2}°)" )

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("J10:J80")) Is Nothing Then
        Dim objRegex As Object
        Dim RegMC As Object
        Dim RegM As Object
        '-----------------------------------------------------
        Target.Font.ColorIndex = 1
        redItems = "(RXB|RXG|RGX|RXC|RCX|RXD|RXE|RXS|RFG|RNG|RCL|RPG|RFL|RFS|RSC|RFW|ROX|ROP|RPB|RIS|RDS|RRW|RRY|RCM|ICE|MAG|RMD|RLI|RLM|RSB|RBI|RBM|ELI|ELM|CAO)"
        blueItems = "(COL|CRT)"
        greenItems = "(AVI|HEG)"
        blue2Items = "(\d{1,2}°-\d{1,2}°|\d{1,2}°)"
        '-----------------------------------------------------
        allItems = redItems & "|" & blueItems & "|" & blue2Items & "|" & greenItems
        Set objRegex = CreateObject("vbscript.regexp")
        With objRegex
            .Global = True
            .Pattern = allItems
            '-----------------------------------------------------
                'On Error Resume Next
                If .test(Range(Target.Address).Value) Then
                    Set RegMC = .Execute(Range(Target.Address).Value)
                    For Each RegM In RegMC
                        If InStr(redItems, RegM) Then
                            Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(255, 0, 0)
                        ElseIf InStr(blueItems, RegM) Then
                            Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 59, 255)
                        ElseIf InStr(blue2Items, RegM) Then
                            Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 59, 255)
                        ElseIf InStr(greenItems, RegM) Then
                            Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 176, 80)
                        End If
                    Next
                End If
        End With
    End If


I tried the regex with a simple sub and it worked, but I cant get it to work in the above code

    Sub RegExpTemps()

    Dim objRegex As Object
    Dim RegMC As Object
    Dim RegM As Object

    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Global = True
        .Pattern = "(\d{1,2}°-\d{1,2}°|\d{1,2}°)"
        For row = 10 To 80
            If .test(Cells(row, 10).Value) Then
                Set RegMC = .Execute(Cells(row, 10).Value)
                For Each RegM In RegMC
                    Cells(row, 10).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 0, 255) 'vbGreen
                Next
            End If
        Next row
    End With
End Sub

The expected result is that strings that contain temperatures (have the degree character) are highlighted when the cell content changes

Define the blue2Items as

blue2Items = "(\d{1,2}°(?:-\d{1,2}°)?)"

It is more concise and means match 1 or 2 digits with ° sign after them and then an optional sequence of - and again 1 or 2 digits with ° sign .

Then, you need to change the font color based on the capturing group that matched. match.Submatches(x) lets you access these values and if you check their length, you will know which one matched.

Use

If .test(Range(Target.Address).Value) Then
    Set RegMC = .Execute(Range(Target.Address).Value)
    For Each RegM In RegMC
        If Len(RegM.Submatches(0)) > 0 Then
            Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(255, 0, 0)
        ElseIf Len(RegM.Submatches(1)) > 0 Then
            Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 59, 255)
        ElseIf Len(RegM.Submatches(2)) > 0 Then
            Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 59, 255)
        ElseIf Len(RegM.Submatches(3)) > 0 Then
            Range(Target.Address).Characters(RegM.FirstIndex + 1, RegM.Length).Font.Color = RGB(0, 176, 80)
        End If
    Next
End If

Test:

在此处输入图片说明

I think your expression is fine, maybe we'd add some optional spaces, for just in case, and hopefully it'd work:

(\d{1,2}(?:\s*)°(?:\s*)-(?:\s*)\d{1,2}(?:\s*)°)\s*|(\d{1,2}(?:\s*)°)

The expression is explained on the top right panel of this demo , if you wish to explore/simplify/modify it, and in this link , you can watch how it would match against some sample inputs step by step, if you like.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM