如何修改代码，使其更快速计算？

sampsonpon

Sub 填色()
Dim i%
With Application
.ScreenUpdating = False
    For i = 1 To 31
    If .Cells(6, i + 6) <> "" Then
        If Weekday(.Cells(6, i + 6), 2) > 5 And .Cells(5, i + 6) = "" Or .Cells(5, i + 6) = "放假" Then
           Range(Cells(7, i + 6), Cells(116, i + 6)).Interior.Color = RGB(141, 180, 226)
        Else
           Range(Cells(7, i + 6), Cells(116, i + 6)).Interior.Color = RGB(255, 255, 255)
        End If
        If Cells(5, i + 6) = "法定假" Then
           Cells(7, i + 6).Resize(110, 1).Interior.Color = RGB(218, 150, 148)
        End If
    Else
       Range(Cells(7, i + 6), Cells(116, i + 6)).Interior.Color = RGB(255, 255, 255)
    End If
    For r = 1 To 110
        If .Cells(r + 6, 4) = "5★" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(49, 134, 155)
        End If
        If .Cells(r + 6, 4) = "4★S" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(192, 80, 77)
        End If
        If .Cells(r + 6, 4) = "4★J" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(255, 0, 0)
        End If
        If .Cells(r + 6, 4) = "3★S" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(0, 128, 0)
        End If
        If .Cells(r + 6, 4) = "3★J" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(255, 0, 255)
        End If
        If .Cells(r + 6, 4) = "2★S" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(226, 107, 10)
        End If
        If .Cells(r + 6, 4) = "2★J" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(0, 0, 255)
        End If
        If .Cells(r + 6, 4) = "1★" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(0, 0, 0)
        End If
     Next r
    Next i
End With
SendKeys "{F9}"
End Sub

1. Sub 填色()
   
2. Dim i%
   
3. With Application
   
4. .ScreenUpdating = False
   
5. For i = 1 To 31
   
6. If .Cells(6, i + 6) <> "" Then
   
7. If Weekday(.Cells(6, i + 6), 2) > 5 And .Cells(5, i + 6) = "" Or .Cells(5, i + 6) = "放假" Then
   
8. Range(Cells(7, i + 6), Cells(116, i + 6)).Interior.Color = RGB(141, 180, 226)
   
9. Else
   
10. Range(Cells(7, i + 6), Cells(116, i + 6)).Interior.Color = RGB(255, 255, 255)
    
11. End If
    
12. If Cells(5, i + 6) = "法定假" Then
    
13. Cells(7, i + 6).Resize(110, 1).Interior.Color = RGB(218, 150, 148)
    
14. End If
    
15. Else
    
16. Range(Cells(7, i + 6), Cells(116, i + 6)).Interior.Color = RGB(255, 255, 255)
    
17. End If
    
18. For r = 1 To 110
    
19. If .Cells(r + 6, 4) = "5★" Then
    
20. Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(49, 134, 155)
    
21. End If
    
22. If .Cells(r + 6, 4) = "4★S" Then
    
23. Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(192, 80, 77)
    
24. End If
    
25. If .Cells(r + 6, 4) = "4★J" Then
    
26. Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(255, 0, 0)
    
27. End If
    
28. If .Cells(r + 6, 4) = "3★S" Then
    
29. Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(0, 128, 0)
    
30. End If
    
31. If .Cells(r + 6, 4) = "3★J" Then
    
32. Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(255, 0, 255)
    
33. End If
    
34. If .Cells(r + 6, 4) = "2★S" Then
    
35. Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(226, 107, 10)
    
36. End If
    
37. If .Cells(r + 6, 4) = "2★J" Then
    
38. Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(0, 0, 255)
    
39. End If
    
40. If .Cells(r + 6, 4) = "1★" Then
    
41. Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(0, 0, 0)
    
42. End If
    
43. Next r
    
44. Next i
    
45. End With
    
46. SendKeys "{F9}"
    
47. End Sub

复制代码

Edifier_1989

If .Cells(r + 6, 4) = "5★" Then
Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(49, 134, 155)
elseIf  .Cells(r + 6, 4) = "4★S" Then
Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(192, 80, 77)
End If

用elseif串联起来，对于同一个单元格判断

sampsonpon

Edifier_1989 发表于 2017-1-13 21:30
If .Cells(r + 6, 4) = "5★" Then
Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(49, 134,  ...

您这是不是没有写完整呀？我是不是该接着写？

Edifier_1989

是的，下面也要改

lsc900707

sampsonpon 发表于 2017-1-13 23:39
您这是不是没有写完整呀？我是不是该接着写？

至少可以这样吧：
For r = 1 To 110
        If .Cells(r + 6, 4) = "5★" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(49, 134, 155)
        elseIf .Cells(r + 6, 4) = "4★S" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(192, 80, 77)
        elseIf .Cells(r + 6, 4) = "4★J" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(255, 0, 0)
       elseIf .Cells(r + 6, 4) = "3★S" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(0, 128, 0)
        elseIf .Cells(r + 6, 4) = "3★J" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(255, 0, 255)
        elseIf .Cells(r + 6, 4) = "2★S" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(226, 107, 10)
        elseIf .Cells(r + 6, 4) = "2★J" Then
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(0, 0, 255)
        else
           Range(Cells(r + 6, 1), Cells(r + 6, 6)).Font.Color = RGB(0, 0, 0)
        End If

yangyangzhifeng

好像没必要嵌套循环吧，去掉嵌套循环应该快不少

sampsonpon

yangyangzhifeng 发表于 2017-1-14 07:49
好像没必要嵌套循环吧，去掉嵌套循环应该快不少

不嵌套的话，代码如何写？

lsc900707

sampsonpon 发表于 2017-1-14 10:06
不嵌套的话，代码如何写？

你没上传附件，所以大家不好处理。

yangyangzhifeng

sampsonpon 发表于 2017-1-14 10:06
不嵌套的话，代码如何写？

直接把for r循环拉到外面不行吗？代码并没有赋值语句，两段循环没有倚赖关系吧

sampsonpon

lsc900707 发表于 2017-1-14 10:11
你没上传附件，所以大家不好处理。

今天休息没有上班，明天传个附件给您看看。谢谢您！