- 帖子
- 2842
- 主題
- 10
- 精華
- 0
- 積分
- 2898
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2025-4-28
|
7#
發表於 2019-3-9 09:55
| 只看該作者
回復 6# john2006168
Sub TEST()
Dim xR As Range, CL, U%, xH As Range, SS
Call 重置
CL = Array(35, 36)
For Each xR In Range("D2:D" & Cells(Rows.Count, "k").End(xlUp).Row) '以k欄取資料列數, xR則從D2往下迴圈
If xR(1, 8) <> xR(0, 8) Then Set xH = xR: SS = 0 'xR(1,8) D欄往右8格, 即是K欄; xR(1, 8) <> xR(0, 8) 1是本格,0是上一格,2是下一格 ---以下程式碼同理
SS = SS + Val(xR(1, 2))
If xR(1, 8) <> xR(2, 8) Then
xH(1, 3) = SS: U = 1 - U
Range(xR(1, 8), xH).Interior.ColorIndex = CL(U)
Range(xH(1, 3), xR(1, 3)).Merge
End If
Next
End Sub
Sub 重置()
With Range([D2], Cells(Rows.Count, "k").End(xlUp))
.UnMerge
.Interior.ColorIndex = 0
.Columns(3).ClearContents
End With
End Sub |
|