表計算

質問

Sub TaskManager()

Dim i As Integer
Dim Maxval As Integer
Dim Counter As Integer
Dim AtoShoriFlg As String

Set SH1 = Worksheets("Sheet1")
Set SH2 = Worksheets("Sheet2")

Maxval = WorksheetFunction.Max(Range("B:B"))
Maxval = Maxval + 1

'初期値設定
i = 7
AtoShoriFlg = "ON"
Counter = 1

Do While Cells(i, 4).Value <> "end"

Select Case Cells(i, 4)

Case Is = "新規エントリー"
AtoShoriFlg = "OFF"
i = i + 1

Case Is = ""
Cells(i - 1, 4).Copy Cells(i, 4)
Cells(i, 4).Font.Color = RGB(255, 255, 255)
SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlLineStyleNone

Case Is <> Cells(i - 1, 4)
SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlContinuous
SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Font.Color = RGB(0, 0, 0)
If Cells(i, 2) = "" Then
Cells(i, 2) = Maxval
Maxval = Maxval + 1
End If
Counter = 1

Case Else
SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlLineStyleNone

End Select

If Cells(i, 2).Value = "" Then

Cells(i, 2) = Cells(i - 1, 2).Value
Cells(i, 2).Font.Color = RGB(255, 255, 255)

End If

If Cells(i, 3).Value = "" And Counter <> 1 Then

Cells(i, 3) = Cells(i - 1, 3).Value
Cells(i, 3).Font.Color = RGB(255, 255, 255)

End If

If AtoShoriFlg = "ON" Then

Cells(i, 7) = Counter
Counter = Counter + 1

End If

i = i + 1

Loop

SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlContinuous

If AtoShoriFlg = "ON" Then

SH2.Range("B2:F5").Copy Destination:=SH1.Cells(i, 2)

End If

End Sub

回答No.1

imogasi

このようにコード（これも我流だろう）だけあげて、（１）したいことの文章による説明もなく、（２）データ例も出さ、（３）エラーが出たとかいう言及もない質問は、おかしいのでは。回答者を、質問すれば、コードを無料で作ってくれる、ありがたい小間使いのように考えているのではないか。
標題も「表計算」だけでは、質問の中身の多少なりともの参考にもならない。
幾らOKWAVEの仕組は、感謝経済と言われてもね。言っても無駄で、スルーすればしまいなのだが、最近画像だけ貼り付けなど、こういうのが多い。