便利というかなんと言うか

家でスクリプト作ってみました

Private Sub マクロ実行_Click()
Call test2
End Sub

Public Sub test1()
Dim MyStr As String
Dim i As Long
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
MyStr = Range("A" & i)
If MyStr <> "" Then
Range("B" & i) = "Hello" & MyStr & "!"
End If
Next i
End Sub

Public Sub test2()
Dim i As Long
Dim WrkRow As Long
Dim WrkCol As Long
Dim WrkRange As Variant
Dim tmp1 As String
Dim tmp2 As String
Dim ssk As Double
Dim hanb As Double
Dim sire As Double
Dim j As Long
Dim startDay As Long

With Sheets("Sheet2") ' シート名
WrkRow = .Cells(Rows.Count, 1).End(xlUp).Row
WrkCol = .Cells(1, Columns.Count).End(xlToLeft).Column
WrkRange = .Range("A1").Resize(WrkRow, WrkCol)
End With

j = 0
Sheets("Sheet4").Activate

ssk = 0
hanb = 0
sire = 0

Dim startCol As Long
startCol = 2

For i = startCol To WrkRow - 1 'MAX
tmp1 = WrkRange(i, 1)
tmp2 = WrkRange(i + 1, 1)
If i = startCol Then
' 初回
' Worksheets("Sheet4").Range("E1") = tmp1
j = 2
End If
hanb = CDbl(Worksheets("Sheet4").Range("C" & i))
'hanb = CDbl(Replace(Worksheets("Sheet4").Range("C" & i), "", "0"))
sire = CDbl(Worksheets("Sheet4").Range("D" & i))
ssk = ssk + hanb - sire

' DEBUG START
Worksheets("Sheet4").Range("F" & i) = ssk
' DEBUG END

startDay = 20100101

If ssk < 0 Then
' 背景色を赤色にする
Worksheets("Sheet4").Range("A" & i & ":E" & i).Select
With Selection.Interior
.ColorIndex = 3 ' 48　灰
.Pattern = xlSolid
End With
ssk = 0
End If

If CLng(Worksheets("Sheet4").Range("B" & i)) < CLng(Worksheets("Sheet4").Range("E" & i)) + startDay Then

' 背景色を灰色にする
Worksheets("Sheet4").Range("A" & i & ":E" & i).Select
With Selection.Interior
.ColorIndex = 48
.Pattern = xlSolid
End With
End If

If tmp1 <> tmp2 Then
'Worksheets("Sheet4").Range("E" & j) = tmp2
'j = j + 1
ssk = 0
End If

If tmp2 = "" Then
' 空白になった時点でブレイク
i = WrkRow
End If

Next i
End Sub