| |
更新（実行）については、ボタンを作って実行するようにしました。
とりあえず30分おきなので「+1」を「0.5」にしました。
また、各行のごとにコピーし、セルを指定する事により
とりあえず下記のように3行分作ってみました。
これを30日分作れば良いということですね。
なんとか作る事が出来そうです。
りったさん本当にありがとうございました。感謝でいっぱいです。
-----------------------------------------------------
Sub countColor()
Dim rIn As Range
Dim rTmp As Range
Set rIn = Range("A1:G1")
Range("H1:J1").ClearContents
For Each rTmp In rIn
Select Case rTmp.Interior.ColorIndex
Case 3 ' 赤
Range("H1").Value = Range("H1").Value + 0.5
Case 6 ' 黄色
Range("I1").Value = Range("I1").Value + 0.5
Case 5 ' 青
Range("J1").Value = Range("J1").Value + 0.5
End Select
Next
Set rIn = Range("A2:G2")
Range("H2:J2").ClearContents
For Each rTmp In rIn
Select Case rTmp.Interior.ColorIndex
Case 3 ' 赤
Range("H2").Value = Range("H2").Value + 0.5
Case 6 ' 黄色
Range("I2").Value = Range("I2").Value + 0.5
Case 5 ' 青
Range("J2").Value = Range("J2").Value + 0.5
End Select
Next
Set rIn = Range("A3:G3")
Range("H3:J3").ClearContents
For Each rTmp In rIn
Select Case rTmp.Interior.ColorIndex
Case 3 ' 赤
Range("H3").Value = Range("H3").Value + 0.5
Case 6 ' 黄色
Range("I3").Value = Range("I3").Value + 0.5
Case 5 ' 青
Range("J3").Value = Range("J3").Value + 0.5
End Select
Next
End Sub
|
|
MOM
- 08/8/29(金) 11:51 -
