Question

请教EXCEL表格查找到某单元格时使该单元格的整行都填充颜色

如题怎么用VBA实现，EXCEL表格查找到某单元格时使该单元格的整行都填充颜色，并且查找下个单元格时，之前所查找的整行单元格颜色保持不变，如图

Answer 1

前几天做的一个小程序 供参考

Sub tus_Main()
Dim sArr(1 To 7) As String
Application.ScreenUpdating = False
sArr(1) = "综合办公室"
sArr(2) = "管网管理部"
sArr(3) = "公明分公司"
sArr(4) = "光明分公司"
sArr(5) = "上村水厂"
sArr(6) = "甲子塘水厂"
sArr(7) = "光明水厂"
'sArr(8) = "待整改隐患"
For i = 1 To 7
Call tuS(sArr(i))
Next i
Application.ScreenUpdating = True
Sheets("汇总表").Activate
End Sub
Sub tuS(sName As String)
Dim hH As Integer
Dim fxJb As Integer '风险级别
Const ksLh = 1, jsLh = 17 'kslh-涂色的开始列号 jslh-涂色的结束列号
Const ksHH = 4
hH = ksHH
Sheets(sName).Activate
Do While Cells(hH, 4) <> ""
fxJb = Cells(hH, 10).Value
Range(Cells(hH, ksLh), Cells(hH, jsLh)).Select
If Cells(hH, 17) = "待整改" Then
Select Case fxJb
Case 1
Call color_1
Case 2
Call color_2
Case 3
Call color_3
Case 4
Call color_4
Case 5
Call color_5
End Select
End If
hH = hH + 1
Loop
End Sub
Sub color_1()
'
'危险程度1级 底色为红色，字体为白色
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
'.Name = "仿宋"
'.FontStyle = "加粗"
'.Size = 18
'.Strikethrough = False
'.Superscript = False
'.Subscript = False
'.OutlineFont = False
'.Shadow = False
'.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
'.ThemeFont = xlThemeFontNone
End With
End Sub
Sub color_2()
'
'危险程度2级 底色为咖啡色，字体为白色
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
End Sub
Sub color_3()
'
'危险程度3级 底色为黄色，字体为黑色
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub
Sub color_4()
'
'危险程度4级 底色为蓝色，字体为黑色
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16776960
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub color_5()
'
' 允许范围内 或 已整改
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub
Sub 宏8()
'
' 宏8 宏
'
'
Application.ReferenceStyle = xlA1
Range("C5:I5").Select
Selection.FormulaR1C1 = "=SUM(R[1]C:R[5]C)"
Range("B5:B10").Select
Selection.FormulaR1C1 = "=SUM(RC[1]:R[1]C[7])"
Range("B5:B10").Select
Selection.ClearContents
Range("B5:B10").Select
Selection.FormulaR1C1 = "=SUM(RC[1]:RC[7])"
End Sub