Выбрать регистр внутри цикла Range - PullRequest
Новая
       5

Выбрать регистр внутри цикла Range

3 голосов
/ 20 июня 2019

Я создал макрос, который стекает по строкам на листе для оценки данных в столбцах и изменения цвета строки и / или цвета текста на основе найденных данных. 

Sub msFormatting()
    Dim lastRow As Long
    Dim r As Long

    Application.ScreenUpdating = False

    lastRow = Cells(Rows.Count, "A").End(xlUp).Row          'Find last populated cell in column A
    For r = 2 To lastRow                                    'Loop through all rows starting from row 2
        Select Case Cells(r, "A")
            Case "m"
                Range(Cells(r, "A"), Cells(r, "AC")).Interior.Color = RGB(255, 204, 204)
            Select Case Cells(r, "C")                       'Find value in column C
                    Case Is > Date - 1825                   'Age is under 5yrs
                    Range(Cells(r, "A"), Cells(r, "AC")).Font.Color = RGB(0, 176, 80)
                   Case Is < Date - 7300                    'Age is over 20yrs
                       Range(Cells(r, "A"), Cells(r, "AC")).Interior.Color = RGB(255, 124, 128)
                       Range(Cells(r, "A"), Cells(r, "AC")).Font.Color = RGB(250, 190, 0)
                End Select
            Case "s"
                Range(Cells(r, "A"), Cells(r, "AC")).Interior.Color = RGB(204, 236, 255)
            Select Case Cells(r, "C")
                    Case Is > Date - 1825
                    Range(Cells(r, "A"), Cells(r, "AC")).Font.Color = RGB(0, 176, 80)
                   Case Is < Date - 7300
                       Range(Cells(r, "A"), Cells(r, "AC")).Interior.Color = RGB(55, 145, 170)
                       Range(Cells(r, "A"), Cells(r, "AC")).Font.Color = RGB(250, 190, 0)
                End Select
            Case ""                                         'Clear formatting when blank
                Range(Cells(r, "A"), Cells(r, "AC")).Interior.Color = RGB(255, 255, 255)
                Range(Cells(r, "A"), Cells(r, "AC")).Font.Color = RGB(0, 0, 0)

        End Select
    Next r

    Application.ScreenUpdating = True

End Sub

На другом листе я хочу использовать аналогичный формат, однако данные находятся только в одной ячейке в строке, но продажи варьируются в каждой строке, поскольку некоторые данные «с отступом» с помощью следующего столбца, чтобы показать ясность.

Я заблудился, пытаясь добавить поиск ячейки в строке, а затем, используя регистр, вычислить первую часть строки текста ячейки, чтобы определить, какое изменение необходимо внести в цвет строки и / или цвет текста на основе найденные данные. 

Sub SahanadFormatting()
    Dim sht As Worksheet
    Dim lastRow As Long
    Dim r As Long
    Dim c As Long

    Application.ScreenUpdating = False

    lastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'Find last populated row on worksheet
    For r = 4 To lastRow                                                                  'Loop through all rows starting from row 4
        With Rows(r)
            .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Select                'find & select cell with data
        End With

        Select Case ActiveCell.Address                                                    'Cell with data
            Case Mid(7, 1) = "m"                                                          'Verify 7th place is mare
                Range(Cells(r, "A"), Cells(r, "Z")).Interior.Color = RGB(255, 204, 204)   'Fill color

            Select Case ActiveCell.Address                                                'Find year foaled
                    Case Left(4, 1) > Year(Now) - 1825                                    'Age is under 5yrs
                    Range(Cells(r, "A"), Cells(r, "Z")).Font.Color = RGB(0, 176, 80)
                    Case Left(4, 1) > Year(Now) - 7300                                    'Age is over 20yrs
                       Range(Cells(r, "A"), Cells(r, "Z")).Interior.Color = RGB(255, 124, 128)
                       Range(Cells(r, "A"), Cells(r, "Z")).Font.Color = RGB(250, 190, 0)
                End Select

            Case Mid(7, 1) = "s"                                                          'Verify 7th place is stallion
                Range(Cells(r, "A"), Cells(r, "Z")).Interior.Color = RGB(204, 236, 255)

'            Select Case Cells(r, "C")
'                    Case Is > Date - 1825
'                    Range(Cells(r, "A"), Cells(r, "Z")).Font.Color = RGB(0, 176, 80)
'                   Case Is < Date - 7300
'                       Range(Cells(r, "A"), Cells(r, "Z")).Interior.Color = RGB(55, 145, 170)
'                       Range(Cells(r, "A"), Cells(r, "Z")).Font.Color = RGB(250, 190, 0)
'                End Select
            Case ""                                         'Clear formatting when blank
                Range(Cells(r, "A"), Cells(r, "Z")).Interior.Color = RGB(255, 255, 255)
                Range(Cells(r, "A"), Cells(r, "Z")).Font.Color = RGB(0, 0, 0)

        End Select
    Next r

    Application.ScreenUpdating = True

End Sub
...