[已解决]请老师帮忙写段代码，先谢谢了

1003136666 · 发表于 2014-10-10 17:50

本帖最后由 1003136666 于 2014-10-10 21:44 编辑

麻烦有空的老师给看看，谢谢

最佳答案

dsmch

2014-10-10 18:53

Sub Macro1()
Dim arr, rng As Range, i&, j%, s&
ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
arr = Range("a4").CurrentRegion
s = UBound(arr) - 1
For j = 3 To UBound(arr, 2)
s2 = Application.Average(Cells(5, j).Resize(s)) * 0.9
For i = 2 To UBound(arr)
If Cells(i + 3, j) < s2 Then
If rng Is Nothing Then Set rng = Cells(i + 3, j) Else Set rng = Union(rng, Cells(i + 3, j))
End If
Next
Next
If Not rng Is Nothing Then rng.Interior.ColorIndex = 3
End Sub

复制代码

数据很多话用代码

dsmch · 发表于 2014-10-10 18:32

条件格式：选中c5:l10,设置条件格式：公式==C5<AVERAGE(C$5:C$10)*0.9

dsmch · 发表于 2014-10-10 18:53

Sub Macro1()
Dim arr, rng As Range, i&, j%, s&
ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
arr = Range("a4").CurrentRegion
s = UBound(arr) - 1
For j = 3 To UBound(arr, 2)
s2 = Application.Average(Cells(5, j).Resize(s)) * 0.9
For i = 2 To UBound(arr)
If Cells(i + 3, j) < s2 Then
If rng Is Nothing Then Set rng = Cells(i + 3, j) Else Set rng = Union(rng, Cells(i + 3, j))
End If
Next
Next
If Not rng Is Nothing Then rng.Interior.ColorIndex = 3
End Sub

复制代码

数据很多话用代码

dsmch · 发表于 2014-10-10 18:55

………………

1003136666 · 发表于 2014-10-10 19:31

dsmch 发表于 2014-10-10 18:55
………………

老师，我自认为我随便做个数据源，改下区域就可以了。可这个代码真是没看明白，也改不会，请原谅数据敏感不能上传。我告诉你区域，是否可以帮忙改下代码，谢谢
数据区域
列：C列至AG列（31列，代表一个月最多31天）
行：5：404（每日有400条数据）
麻烦老师了

1003136666 · 发表于 2014-10-10 19:44

1003136666 发表于 2014-10-10 19:31
老师，我自认为我随便做个数据源，改下区域就可以了。可这个代码真是没看明白，也改不会，请原谅数据敏感 ...

麻烦了

1003136666 · 发表于 2014-10-10 19:45

dsmch 发表于 2014-10-10 18:55
………………

麻烦老师了

1003136666 · 发表于 2014-10-10 21:15

dsmch 发表于 2014-10-10 18:55
………………

我下了二楼的附件啊，可用到后面这个表里就不行了

dsmch · 发表于 2014-10-10 21:30

二楼附件到目前为止下载次数为0，鉴于此不再关注

1003136666 · 发表于 2014-10-10 21:40

dsmch 发表于 2014-10-10 21:30
二楼附件到目前为止下载次数为0，鉴于此不再关注

我见二楼老师回复的是技巧解决，我也用条件格式操作了，完成可以，所以没下附件。
我原意是想找个快捷的方法
惹老师生气了
我现在只能把12个工作表选中，按二楼的方法操作一次的同时，录制一个宏，用这个宏做个按钮了。
不管怎么样，谢谢老师耐心解答
谢谢

		自动登录	找回密码
密码			注册