[已解决]用VBA实现条件格式

可爱的小胖猪

求高手们帮忙

其实用条件格式是很好实现，但是考虑数据量大，用条件格式太卡，所以不知道用VBA能不能实现

最佳答案

月排行榜 / 总排行榜

grf1973

2014-5-20 15:56

请看附件。似乎第7句改成  arr = Range(Cells(r, 5), Cells(r, c)) 更为妥当一点。

跳转到最佳答案楼层

可爱的小胖猪

没人给解决一下吗？

grf1973

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     r = Target.Row   '当前行
   
3.     c = Target.Column   '当前列
   
4.     mc = Cells(2, 256).End(xlToLeft).Column   '最大列
   
5.     r1 = 3 + Int((r - 3) / 4) * 4    '令数所在的行
   
6.     ls = Cells(r1, 3)   '令数
   
7.     arr = Range(Cells(r, 5), Cells(r, mc))
   
8.    
   
9.     If Cells(2, c) = "计划" Then    '计划栏
   
10.         For j = 2 To UBound(arr, 2) Step 2
    
11.             s1 = s1 + arr(1, j)   '计划数
    
12.             s2 = s2 + arr(1, j - 1) '完成数
    
13.         Next
    
14.         If s1 + s2 > ls Then
    
15.             MsgBox "计划数+完成数大于令数"
    
16.             Application.EnableEvents = False
    
17.             Target.ClearContents
    
18.             Application.EnableEvents = True
    
19.             Exit Sub
    
20.         End If
    
21.     End If
    
22.    
    
23.     If Cells(2, c) = "完成" Then    '完成
    
24.         For j = 1 To UBound(arr, 2) Step 2
    
25.             s = s + arr(1, j)   '完成数
    
26.         Next
    
27.         If s > ls Then
    
28.             MsgBox "完成数大于令数"
    
29.             Application.EnableEvents = False
    
30.             Target.ClearContents
    
31.             Application.EnableEvents = True
    
32.             Exit Sub
    
33.         End If
    
34.         
    
35.         If Cells(r, 4) = "组装" Then    '组装行确定条件格式
    
36.             If s = ls Then
    
37.                 Cells(r1, 1).Resize(4, 3).Interior.Color = vbRed
    
38.             Else
    
39.                 Cells(r1, 1).Resize(4, 3).Interior.ColorIndex = 0
    
40.             End If
    
41.         End If
    
42.     End If
    
43. End Sub
    

复制代码

grf1973

请看附件。似乎第7句改成  arr = Range(Cells(r, 5), Cells(r, c)) 更为妥当一点。

可爱的小胖猪

谢谢，基本上实现了要求，不过有点小瑕疵，我自己研究一下！

在提示超出计划数的时候，你把以往所有的计划数加上所有的完成数，所以会有问题，执行完毕了计划数就不用考虑进去了，只是你重新下计划的时候，是不是超出剩余的未完成的计划才要提示！

不过很感谢你，我看出一点眉目了，自己研究一下，如果搞不明白再请教！
非常感谢

可爱的小胖猪

把14行的S1改成cells（r，c）就很完美了，哈哈，非常感谢，又学到好多东西

可爱的小胖猪

grf1973 发表于 2014-5-20 15:56
请看附件。似乎第7句改成  arr = Range(Cells(r, 5), Cells(r, c)) 更为妥当一点。

能不能帮我看看，我现在一运行就自动关闭了，到底什么原因啊，谢谢

grf1973

里面好多问题，一时说不清。重新改了一下，至少不会闪退了。至于是否达到要求，你自己调试吧。

可爱的小胖猪

grf1973 发表于 2014-5-21 09:46
里面好多问题，一时说不清。重新改了一下，至少不会闪退了。至于是否达到要求，你自己调试吧。

当运行后，第一次显示提示后，后面再操作就不取作用了，这是为什么？

可爱的小胖猪

grf1973 发表于 2014-5-21 09:46
里面好多问题，一时说不清。重新改了一下，至少不会闪退了。至于是否达到要求，你自己调试吧。

我用的是WPS，我发现你给我的程序里面用EXIT SUB，调试的时候运行到这个就停住了，然后在操作就不行了，后来我将EXIT SUB统一改成 goto 语句跳出程序就可以了

这是不是WPS的关系，微软的是不是不会这样啊