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

dsmch

1. Sub Macro1()
   
2. Dim arr, rng As Range, i&, j%, s&, k%
   
3. Application.ScreenUpdating = False
   
4. For k = 1 To Sheets.Count
   
5.     Sheets(k).Activate
   
6.     ActiveSheet.UsedRange.Font.ColorIndex = 0
   
7.     arr = [a1:ag404]
   
8.     s = UBound(arr)
   
9.     For j = 3 To UBound(arr, 2)
   
10.         s2 = arr(s, j) / (s - 2) * 0.9
    
11.         For i = 2 To UBound(arr) - 1
    
12.             If Cells(i, j) < s2 Then
    
13.                 If rng Is Nothing Then Set rng = Cells(i, j) Else Set rng = Union(rng, Cells(i, j))
    
14.             End If
    
15.         Next
    
16.     Next
    
17.     If Not rng Is Nothing Then rng.Font.ColorIndex = 3
    
18.     Set rng = Nothing
    
19. Next
    
20. Application.ScreenUpdating = True
    
21. End Sub

复制代码

1003136666

dsmch 发表于 2014-10-10 22:09

谢谢老师的大气量