[已解决]再次请教

ping052062

附件里代码在实用中又有新的问题，麻烦老师们抽时间给看看。详情看附件里。

最佳答案

月排行榜 / 总排行榜

蓝桥玄霜

2013-6-20 17:21

1. Sub aa()
   
2. Dim i%, j%, k%, l%, m%, Arr, ii&
   
3. Arr = [c1].CurrentRegion
   
4. For ii = 1 To UBound(Arr)
   
5.     i = Int(Arr(ii, 1))
   
6.     j = Int(Arr(ii, 2))
   
7.     If i = 0 Or j = 0 Then GoTo 100
   
8.     Cells(ii, 5).Resize(1, 4).Interior.ColorIndex = 36
   
9.     k = j - i + 5
   
10.     If k < 5 Then k = k + 4
    
11.     Cells(ii, k).Interior.ColorIndex = 5
    
12.     m = 1
    
13.     For l = 1 To 4 - j
    
14.         If k + m > 8 Then m = m - 4
    
15.         Cells(ii, k + m).Interior.ColorIndex = 3
    
16.         m = m + 1
    
17.     Next l
    
18. 100:
    
19. Next
    
20. End Sub
    
21. 
    

复制代码

跳转到最佳答案楼层

蓝桥玄霜

1. Sub aa()
   
2. Dim i%, j%, k%, l%, m%, Arr, ii&
   
3. Arr = [c1].CurrentRegion
   
4. For ii = 1 To UBound(Arr)
   
5.     i = Int(Arr(ii, 1))
   
6.     j = Int(Arr(ii, 2))
   
7.     If i = 0 Or j = 0 Then GoTo 100
   
8.     Cells(ii, 5).Resize(1, 4).Interior.ColorIndex = 36
   
9.     k = j - i + 5
   
10.     If k < 5 Then k = k + 4
    
11.     Cells(ii, k).Interior.ColorIndex = 5
    
12.     m = 1
    
13.     For l = 1 To 4 - j
    
14.         If k + m > 8 Then m = m - 4
    
15.         Cells(ii, k + m).Interior.ColorIndex = 3
    
16.         m = m + 1
    
17.     Next l
    
18. 100:
    
19. Next
    
20. End Sub
    
21. 
    

复制代码