求老师们用VBA给表格填充颜色

woailijiao

现将老师代码及注释整理如下：

1. Sub 填充颜色字体()
   
2.     Dim arr, i&, j&, sScore As Single, rng As Range
   
3.     Application.ScreenUpdating = False    '应用程序屏幕更新 = 没有
   
4.     With Sheets("sheet1")
   
5.     .[f2:m100].Interior.ColorIndex = 0    '填充颜色清0
   
6.     .[f2:m100].Font.ColorIndex = 0        '字体颜色清零
   
7.     .[f2:m100].Font.Bold = False          '字体加粗清零
   
8.     arr = .Range(.Cells(Rows.Count, "M").End(xlUp), "F1")
   
9.    
   
10.     Set rng = .Range(.Cells(Rows.Count, "M").End(xlUp), "F1")
    
11.     For i = 2 To 5     'ubound(arr,2)
    
12.      For j = 2 To UBound(arr)       '循环从第2行开始
    
13.            sScore = .Cells(j, "m")  '改成 M 列,每行与其的值,不是固定数值,[m3],[m4],[m5]....
    
14.          If arr(j, i) >= sScore Then   '大于等于分数(m列)
    
15.             Select Case rng.Cells(1, i).Value
    
16.             Case Is = "第三次模拟成绩"
    
17.             rng.Cells(j, 2).Font.Color = vbRed
    
18.             rng.Cells(j, 2).Font.Bold = True
    
19.             rng.Cells(j, 2).Interior.Color = RGB(240, 165, 120)
    
20.             Case Is = "第二次模拟成绩"
    
21.             rng.Cells(j, 3).Font.Color = vbRed
    
22.             rng.Cells(j, 3).Font.Bold = False
    
23.             rng.Cells(j, 3).Interior.Color = RGB(240, 175, 135)
    
24.             Case Is = "第一次模拟成绩"
    
25.             rng.Cells(j, 4).Font.Color = vbRed
    
26.             rng.Cells(j, 4).Font.Bold = False
    
27.             rng.Cells(j, 4).Interior.Color = RGB(240, 185, 150)
    
28.             Case Is = "期中模拟成绩"
    
29.             rng.Cells(j, 5).Font.Color = vbRed
    
30.             rng.Cells(j, 5).Font.Bold = False
    
31.             rng.Cells(j, 5).Interior.Color = xlNone   'xlNone 无填充色
    
32.             End Select
    
33.             
    
34.          End If
    
35.       Next j
    
36.     Next i
    
37.     End With
    
38.     '--------------以下为表头字体颜色---------------------------
    
39.     'With Sheet1.Range("f1:m1")
    
40.     '    .Font.Name = "宋体"
    
41.     '    .Font.Size = 12
    
42.     '    .Columns.AutoFit
    
43.     'End With
    
44.     '--------------以下为区域边框线条字体等样式--------------
    
45.     'With Sheet1.[f2].CurrentRegion.Offset(1)
    
46.     '.Font.Name = "arial"
    
47.     '.Font.Size = 9
    
48.     '.Borders.LineStyle = xlContinuous
    
49.     '.HorizontalAlignment = xlCenter
    
50.     'End With
    
51.     '-------------------------------------------------------------------
    
52.     Application.ScreenUpdating = True    '应用程序屏幕更新 = 是的
    
53.    
    
54. End Sub

复制代码

杨建营

woailijiao 发表于 2022-12-8 23:43
你好，老师，这个  sScore = 453 不是固定值，怎样改成M列 与其它列对应比较。

忽略了一个循环，等我测试吧。

杨建营

请楼主参考。