Как выделить температурные строки с помощью регулярных выражений в Excel VBA

Question

Когда содержимое ячейки изменяется, некоторые строки подсвечиваются.Эту часть я уже получил на работу.Теперь я добавил регулярное выражение для выделения строк, которые также содержат температуру (т.е. 13 ° или 10 ° -25 °). Эта часть, однако, не работает (без ошибок, но просто без вывода)

Это то, что у меня естьдо сих пор.Это все работает, за исключением этой части (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

Ожидаемый результат состоит в том, что строки, которые содержат температуры (имеют символ степени), будут выделены при изменении содержимого ячейки

Answer 1

Определите blue2Items как

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

Это более кратко и означает совпадение 1 или 2 цифр со знаком ° после них, а затем необязательная последовательность - и еще раз 1 или 2 цифры со знаком ° .

Затем вам нужно изменить цвет шрифта, основываясь на соответствующей группе захвата. match.Submatches(x) позволяет получить доступ к этим значениям, и если вы проверите их длину, вы узнаете, какое из них соответствует.

Используйте

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

Тест:

Answer 2

Я думаю, что с вашим выражением все в порядке, может быть, мы добавим несколько дополнительных пробелов, на всякий случай, и, надеюсь, это сработает:

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

Выражение объяснено на верхней правой панели этой демонстрации , если вы хотите изучить / упростить / изменить его, а в этой ссылке вы можете посмотреть, как оно будет если хотите, сравнивайте с некоторыми примерами ввода шаг за шагом