[發問] 連續3週以上資料標示

jcchiang

下載 (17.33 KB)

2015-2-25 12:40

請教各位先進:
由右邊最後一週算起,連續3週以上的行列,以黃色底色標示,如何以VB完成

stillfish00

回復 1# jcchiang

1. Sub Test()
   
2.     Dim ar, i As Long, j As Long, cmax As Long
   
3.    
   
4.     With ActiveSheet
   
5.         ar = .[A1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column).value
   
6.         cmax = UBound(ar, 2)
   
7.         For i = 2 To UBound(ar)
   
8.             For j = cmax To 2 Step -1
   
9.                 If ar(i, j) = "" Then Exit For
   
10.             Next
    
11.             If cmax - j >= 3 Then .Range(.Cells(i, j + 1), .Cells(i, cmax)).Interior.Color = vbYellow
    
12.         Next
    
13.     End With
    
14. End Sub

複製代碼

jcchiang

回復 2# stillfish00

測試無問題,謝謝大大指教

GBKEE

回復 2# stillfish00

1. For j = cmax To 2 Step -1
   
2.                 If ar(i, j) = "" Then Exit For '沒有資料跳出迴圈
   
3.             Next

複製代碼

你的程式碼只可標示出由最後往前算連續3週以上資料
如資料有中斷後,再往前還有連續3週以上資料,你的程式碼無法標出儲存格底色

修正一下,可標出資料中不只一個區間有連續3週以上資料儲存格底色

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim R As Long, C As Long, Cmax As Integer
   
4.     With ActiveSheet.Range("A1").CurrentRegion
   
5.         .Cells.Interior.ColorIndex = xlNone
   
6.         For R = 2 To .Rows.Count
   
7.             C = 2
   
8.             Do While C <= .Columns.Count
   
9.                 Cmax = 0
   
10.                 Do While .Cells(R, C + Cmax) <> ""
    
11.                     Cmax = Cmax + 1
    
12.                 Loop
    
13.                 If Cmax >= 3 Then .Cells(R, C).Resize(, Cmax).Interior.Color = vbYellow
    
14.                 C = C + 1 + Cmax
    
15.             Loop
    
16.         Next
    
17.     End With
    
18. End Sub

複製代碼