VBA怎么动态颜色填充

WE2021

各位老师VBA怎么动态填充？填充区域在R1：AD5以下数字
（R1：AD5是动态的有时3行，有时6行，注意列数也是动态的；但是填充的数字行数也是动态变化总跟着隔两行）
谢谢！



动态填充.zip (7.95 KB, 下载次数: 23)

2022-12-13 13:11 上传

点击文件名下载附件

zxsea_7426

看了个寂寞，完全没有看明白

于箱长

完全看不懂+1

ykcbf1100

完全看不懂+2
求问：下面的数据是如何产生的？和上方的数据因何关联？

WE2021

ykcbf1100 发表于 2022-12-13 15:55
完全看不懂+2
求问：下面的数据是如何产生的？和上方的数据因何关联？

老师
上面是随机产生（随机的行列是时多时少，所以下面的比对结果跟着变）！下面是比对后出现的结果。
结果区域大于平均值的数填充红底白字。

fzxba

1. Sub test1()
   
2.   Dim ar, i As Long, j As Long, n As Double
   
3.   Dim Ran As Range, Target As Range
   
4.   With Range("R1")
   
5.     i = .CurrentRegion.Rows.Count
   
6.     j = .CurrentRegion.Columns.Count
   
7.     Set Target = .Offset(i + 1)
   
8.   End With
   
9.   Set Ran = Target
   
10.   With Target.Offset(1).Resize(i, j)
    
11.     ar = .Value
    
12.     n =-int (- WorksheetFunction.Average(ar) )  '见它处说明，此行改一下，审核真扯淡……
    
13.     For i = 1 To UBound(ar)
    
14.       For j = 1 To UBound(ar, 2)
    
15.         If ar(i, j) > n Then Set Ran = Union(Ran, .Cells(i, j))
    
16.       Next
    
17.     Next
    
18.     .ClearFormats
    
19.   End With
    
20.   With Ran
    
21.     .Interior.Color = vbRed
    
22.     .Font.Color = vbWhite
    
23.   End With
    
24.   Target.Clear
    
25.   Set Target = Nothing
    
26.   Set Ran = Nothing
    
27. End Sub

复制代码