[英]Excel Macro to Change Color of a Row Based on Column and Cell Value
I have the below code and would like it to be modified to work on all worksheets in the active workbook. 我有以下代码,希望对其进行修改以在活动工作簿中的所有工作表上工作。 Also, it currently does the entire row, but is there a way to modify it to only highlight the row until the data stops (example: AJ or AC etc. not A-~)?
另外,它当前处理整个行,但是有没有办法修改它以仅突出显示行直到数据停止(例如: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
You can use the below, you needed to change the range in the if
statement. 您可以使用以下内容,您需要在
if
语句中更改范围。
You haven't given worksheet names here, but you should really fully reference all your ranges too. 您尚未在此处提供工作表名称,但实际上也应该完全引用所有范围。
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
Try this (note I have added declarations to your code). 试试这个(注意我已经在您的代码中添加了声明)。
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
This is simular to some of the above ... difference is it will hi-lite from the beginning to the last used column. 这与上述某些情况类似...区别在于它将从开始到最后使用的列都是高清晰度的。 It also cycles through all the sheets in the activeworkbook.
它还在活动工作簿中的所有工作表之间循环。 It assumes the District Name is in column A.
假定地区名称在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
The code below will loop through all sheets in ActiveWorkbook
(even though I feel strongly against using ActiveWorkbook
), and per each sheet loop through MR
range. 下面的代码将遍历
ActiveWorkbook
所有工作表(即使我强烈反对使用ActiveWorkbook
),并且每个工作表都会遍历MR
范围。
I've replaced your multiple Ifs
with Select Case
. 我已将您的多个
Ifs
替换为Select Case
。
Code 码
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
This should work for you. 这应该为您工作。 You can set a begin and end point to your liking just by changing the letters, which is a reference to the column letters.
您可以仅通过更改字母(这是对列字母的引用)来设置自己喜欢的起点和终点。
Range("A" & n, "G" & n)
This is a simpler way to get what you want. Range("A" & n, "G" & n)
这是一种获取所需内容的简单方法。
Hope I helped. 希望我能帮上忙。
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
i have made a similar thing to color rows in a table in Excel. 我做了类似的事情,以彩色Excel中的表中的行。 this below algo is not much efficient but can make significant changes for it's optimization.
这种低于算法的方法效率不高,但是可以对其进行重大更改。
This will do your task. 这将完成您的任务。
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
End Sub 结束子
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.