(3)項目をシート名にして自動作成する
日報の浅井・大西シートを準備します。
項目は日付・客先・時間とします、実際はもっと項目がついていますが勉強のために3つにしておきます。
(a)作業シートにコピー
For i = 2 To lastrow
Worksheets("作業").Cells(j, 1) = Worksheets("浅井").Cells(i, 1)
どのシートを繰り返す(先頭から最後まで見ていくのか)のかとコピー元コピー先をはっきり理解することです。
この場合はコピー元右辺の浅井シートがメインです。
lastrowは浅井シートの最終行です。
行数を指定するjの動きも理解してください。
jはFor Nextで自動加算しないので自分でj=j+1で加算しています。
(b)並び替え
並び替えは何も考えずに部品集http://vba.asai.net/buhind.html
の並び替え(2つのキーの場合)セルを使った例を使ってください。
ポイントは並び替える範囲とキーの座標値です。
同じシートの中で並び替えます。
(c)シートの作成
これが今回の一番のポイントです。
毎回存在している客先シートに日報の追加分を追加するのはプログラムが難しくなるため客先シートを削除して新たに追加しそのシートにすべての日報データをコピーする方法をとります。
ここが人間の思考と単純仕事を何度頼んでも文句をいわないコンピュータの特徴であり大きな違いです。
そのためには
・シートが存在しているかを確かめる事
・そのシートを削除する
・シートを追加する
・シートの名前を変更する
以上の操作を学ばないといけません。
それらをすべて部品集シート関連
http://vba.asai.net/buhins.html
からコピーすればよろしい。
For i = 2 To j - 1
If Worksheets("作業").Cells(i, 2) <> sname Then
sname = Worksheets("作業").Cells(i, 2)
条件付き繰り返しを使って客先名が変わったときプログラム変数とセル変数のif文で判断してシートを追加すればよろしい、今回は作業の最後の行が以前使っていますのでjを使っているのでコピーの行移動に新たにkの変数をつかっています。
Sub sakusei()
Dim i As Long
Dim j As Long
Dim k As Long
Dim lastrow As Long
Dim sname As String
Dim ws As Worksheet
Worksheets("作業").Cells.Clear
Worksheets("作業").Cells(1, 1) = "日付"
Worksheets("作業").Cells(1, 2) = "客先"
Worksheets("作業").Cells(1, 3) = "時間"
Worksheets("作業").Cells(1, 4) = "担当"
j = 2
'浅井シートのデータを作業シートにコピー
lastrow = Worksheets("浅井").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
Worksheets("作業").Cells(j, 1) = Worksheets("浅井").Cells(i, 1)
Worksheets("作業").Cells(j, 2) = Worksheets("浅井").Cells(i, 2)
Worksheets("作業").Cells(j, 3) = Worksheets("浅井").Cells(i, 3)
Worksheets("作業").Cells(j, 4) = "浅井"
j = j + 1
Next
'大西シートのデータを作業シートに追加
lastrow = Worksheets("大西").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
Worksheets("作業").Cells(j, 1) = Worksheets("大西").Cells(i, 1)
Worksheets("作業").Cells(j, 2) = Worksheets("大西").Cells(i, 2)
Worksheets("作業").Cells(j, 3) = Worksheets("大西").Cells(i, 3)
Worksheets("作業").Cells(j, 4) = "大西"
j = j + 1
Next
'客先と日付で並び替える
Worksheets("作業").Activate
Range(Cells(2, 1), Cells(j - 1, 4)).Select
ActiveWorkbook.Worksheets("作業").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(1, 2), SortOn _
:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(1, 1), SortOn _
:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("作業").Sort
.SetRange Range(Cells(2, 1), Cells(j - 1, 4))
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'シートの削除後作成
sname = Worksheets("作業").Cells(2, 2)
For Each ws In Worksheets
If ws.Name = sname Then
Application.DisplayAlerts = False
Worksheets(sname).Delete
Application.DisplayAlerts = True
End If
Next
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sname
Worksheets(sname).Cells(1, 1) = "日付"
Worksheets(sname).Cells(1, 2) = "担当"
Worksheets(sname).Cells(1, 3) = "時間"
k = 2
For i = 2 To j - 1
If Worksheets("作業").Cells(i, 2) <> sname Then
sname = Worksheets("作業").Cells(i, 2)
For Each ws In Worksheets
If ws.Name = sname Then
Application.DisplayAlerts = False
Worksheets(sname).Delete
Application.DisplayAlerts = True
End If
Next
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sname
Worksheets(sname).Cells(1, 1) = "日付"
Worksheets(sname).Cells(1, 2) = "担当"
Worksheets(sname).Cells(1, 3) = "時間"
k = 2
End If
Worksheets(sname).Cells(k, 1) = Month(Worksheets("作業").Cells(i, 1)) & "月" & Day(Worksheets("作業").Cells(i, 1)) & "日"
Worksheets(sname).Cells(k, 2) = Worksheets("作業").Cells(i, 4)
Worksheets(sname).Cells(k, 3) = Worksheets("作業").Cells(i, 3)
k = k + 1
Next
End Sub