ビジネスに役立つ講座や交流会を開催
社長・個人事業主からサラリーマン・主婦まで、どなたでも
アベノ塾

ホーム  会場案内  お問合せ

〒545-0052
大阪市阿倍野区阿倍野筋3-12-2
あべのクオレ1F
(ナガセキャリアプラザ アベノ校)
TEL 06-6647-5571

(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

完成例