在范围循环内选择大小写

时间:2019-06-20 04:33:51

标签: excel vba select case

我创建了一个宏,该宏顺着工作表中的行向下流动,以评估列中的数据,并根据找到的数据更改行颜色和/或文本颜色。

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

在另一个工作表上,我想使用类似的格式,但是数据仅在该行的一个单元格中,但是由于某些数据通过使用下一列来“缩进”,因此每行的销售情况有所不同。 / p>

我迷路了,尝试添加对行中单元格的搜索,然后使用这种情况,评估单元格文本字符串的第一部分,以根据需要确定对行颜色和/或文本颜色的更改找到数据。

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

0 个答案:

没有答案