Excel宏可根据列和单元格值更改行的颜色

Question

我有以下代码，希望对其进行修改以在活动工作簿中的所有工作表上工作。 另外，它当前处理整个行，但是有没有办法修改它以仅突出显示行直到数据停止（例如：AJ或AC等，而不是A-〜）？

Sub ChangeColor()

lRow = Range("A" & Rows.Count).End(xlUp).Row
Set MR = Range("A2:K2" & lRow)
For Each cell In MR
    If cell.Value = "CENTRL DISTRICT" Then cell.EntireRow.Interior.ColorIndex = 10
    If cell.Value = "KC DISTRICT" Then cell.EntireRow.Interior.ColorIndex = 3
    If cell.Value = "NE DISTRICT" Then cell.EntireRow.Interior.ColorIndex = 11
    If cell.Value = "SE DISTRICT" Then cell.EntireRow.Interior.ColorIndex = 30
    If cell.Value = "ST LOUIS DIST" Then cell.EntireRow.Interior.ColorIndex = 12
    If cell.Value = "SW DISTRICT" Then cell.EntireRow.Interior.ColorIndex = 13
Next

End Sub

Answer 1

您可以使用以下内容，您需要在if语句中更改范围。

您尚未在此处提供工作表名称，但实际上也应该完全引用所有范围。

Sub ChangeColor()
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    Set MR = Range("A2:K2" & lRow)
    For Each cell In MR
        If cell.Value = "CENTRL DISTRICT" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 10
        If cell.Value = "KC DISTRICT" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 3
        If cell.Value = "NE DISTRICT" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 11
        If cell.Value = "SE DISTRICT" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 30
        If cell.Value = "ST LOUIS DIST" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 12
        If cell.Value = "SW DISTRICT" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 13
    Next
End Sub

Answer 2

试试这个（注意我已经在您的代码中添加了声明）。

Sub ChangeColor()

Dim lRow As Long, MR As Range, cell As Range, ws As Worksheet, lCol As Long
Dim wf As WorksheetFunction

Set wf = WorksheetFunction

For Each ws In Worksheets
    lRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    lCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    Set MR = ws.Range("A2").Resize(lRow - 1, lCol)
    For Each cell In MR
        If cell.Value = "CENTRL DISTRICT" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 10
        If cell.Value = "KC DISTRICT" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 3
        If cell.Value = "NE DISTRICT" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 11
        If cell.Value = "SE DISTRICT" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 30
        If cell.Value = "ST LOUIS DIST" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 12
        If cell.Value = "SW DISTRICT" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 13
    Next cell
Next ws

End Sub

Answer 3

这与上述某些情况类似...区别在于它将从开始到最后使用的列都是高清晰度的。 它还在活动工作簿中的所有工作表之间循环。 假定地区名称在A列中。

Sub ChangeColor()

    For x = 1 To ActiveWorkbook.Sheets.Count

    Sheets(x).Select

    lRow = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Row
    lCol = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Column
    Set MR = Range("A2:A" & lRow)

      For Each cell In MR
        If cell.Value = "CENTRL DISTRICT" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 10
        If cell.Value = "KC DISTRICT" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 3
        If cell.Value = "NE DISTRICT" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 11
        If cell.Value = "SE DISTRICT" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 30
        If cell.Value = "ST LOUIS DIST" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 12
        If cell.Value = "SW DISTRICT" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 13
      Next

    Next x

End Sub

Answer 4

下面的代码将遍历ActiveWorkbook所有工作表（即使我强烈反对使用ActiveWorkbook ），并且每个工作表都会遍历MR范围。

我已将您的多个Ifs替换为Select Case 。

码

Option Explicit

Sub ChangeColor()

Dim lRow As Long, lCol As Long
Dim MR As Range, Cell As Range
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Sheets
    With ws
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set MR = .Range("A2:K2" & lRow)
        For Each Cell In MR
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column ' <-- in case the last column is different per row
            Select Case Cell.Value
                Case "CENTRL DISTRICT"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 10
                Case "KC DISTRICT"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 3
                Case "NE DISTRICT"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 11
                Case "SE DISTRICT"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 30
                Case "ST LOUIS DIST"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 12
                Case "SW DISTRICT"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 13
            End Select
        Next Cell
    End With
Next ws

End Sub

Answer 5

这应该为您工作。 您可以仅通过更改字母（这是对列字母的引用）来设置自己喜欢的起点和终点。 Range("A" & n, "G" & n)这是一种获取所需内容的简单方法。

希望我能帮上忙。

    Sub ChangeColor()
    Dim nlast As Long

    Sheets("sheetname").Activate
    Set sht = ActiveWorkbook.ActiveSheet
        nlast = Cells(Rows.Count, "A").End(xlUp).Row

                For n = nlast To 1 Step -1
                 If sht.Cells(n, "A").Value = "CENTRL DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 10
                 If sht.Cells(n, "A").Value = "KC DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 3
                 If sht.Cells(n, "A").Value = "NE DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 11
                 If sht.Cells(n, "A").Value = "SE DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 30
                 If sht.Cells(n, "A").Value = "ST DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 12
                 If sht.Cells(n, "A").Value = "SW DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 13
            Next n
     End Sub

Answer 6

我做了类似的事情，以彩色Excel中的表中的行。 这种低于算法的方法效率不高，但是可以对其进行重大更改。

这将完成您的任务。

Private Sub CommandButton21_Click()
Dim i As Integer
i = 2
Dim previousText As String
Dim interiorColorIndex As Integer
Dim fontColorIndex As Integer
interiorColorIndex = 48
fontColorIndex = 2

Do While Cells(i, 3).Value <> ""
    Dim newText As String
    text = Cells(i, 3).Value
    text = Mid(text, 1, 7)

    If previousText = "" Then previousText = text

    If text = previousText Then
        For j = 1 To 10
            Cells(i, j).Interior.ColorIndex = interiorColorIndex
            Cells(i, j).Font.ColorIndex = fontColorIndex
        Next j
    Else
        previousText = text
        If interiorColorIndex = 25 Then
            interiorColorIndex = 48
        Else
            interiorColorIndex = 25
        End If
        For j = 1 To 10
            Cells(i, j).Interior.ColorIndex = interiorColorIndex
            Cells(i, j).Font.ColorIndex = fontColorIndex
        Next j
    End If

    i = i + 1
Loop

结束子