（９）食堂データの計算

・アマノ社等の業務システムから取り出した毎日の食堂の売上データ（CSV形式）をエクセルに変換する。
・修正を行い月次のデータに合体する。
・月次の食堂利用データから社員で集計する。
・集計したデータをCSV形式で出力し給与奉行等のパッケージソフトにインポートする形式に変換する。

Sub csv取り込み()
    Dim FileNamePath As Variant
    Dim textline, csvline() As String
    Dim Rowcnt, ColumNum As Integer
    Dim ch1 As Long
    Worksheets("毎日").Cells.Clear
    ch1 = FreeFile
    FileNamePath = "d:\移行データ\syokudou.csv"
    Open FileNamePath For Input As #ch1
    Rowcnt = 1
    Do While Not EOF(ch1)
        Line Input #ch1, textline
        csvline() = Split(textline, ",")
        Range(Worksheets("毎日").Cells(Rowcnt, 1), _
            Worksheets("毎日").Cells(Rowcnt, UBound(csvline()) + 1)) = csvline()
        Rowcnt = Rowcnt + 1
    Loop
    MsgBox "csvデータ取り込み終わりました"
End Sub

今日の日が表示されていますので変更があれば訂正してＯＫボタンをクリックすると
その日付が入力されて合体されます。

Sub gattai()
    Dim hiduke As String
    Dim lastrow As Long
    Dim lastrow1 As Long
    Dim i As Long
    lastrow = Worksheets("毎日").Cells(Rows.Count, 1).End(xlUp).Row
    lastrow1 = Worksheets("合体").Cells(Rows.Count, 1).End(xlUp).Row
    hiduke = InputBox(Prompt:="合体日は", Default:=Date)
    For i = 2 To lastrow
        Worksheets("合体").Cells(lastrow1 + 1, 1) = hiduke
        Worksheets("合体").Cells(lastrow1 + 1, 2) = Worksheets("毎日").Cells(i, 1)
        Worksheets("合体").Cells(lastrow1 + 1, 3) = Worksheets("毎日").Cells(i, 2)
        Worksheets("合体").Cells(lastrow1 + 1, 4) = Worksheets("毎日").Cells(i, 3)
        lastrow1 = lastrow1 + 1
    Next
    For i = 2 To lastrow
        Worksheets("毎日").Cells(i, 1) = ""
        Worksheets("毎日").Cells(i, 2) = ""
        Worksheets("毎日").Cells(i, 3) = ""
    Next
    MsgBox "合体されました"
End Sub

・社員を並び替えます
・社員の行と次の行の社員と比べて異なれば社員と金額計を別のシート社員計にコピーします。

Sub keisan()
    Dim lastrow As Long
    Dim i As Long
    Dim j As Long
    Dim kei As Long
    lastrow = Worksheets("合体").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("作業").Cells.Clear
    Worksheets("作業").Cells(1, 1) = "社員"
    Worksheets("作業").Cells(1, 2) = "金額"
    j = 2
    For i = 2 To lastrow
        Worksheets("作業").Cells(j, 1) = Worksheets("合体").Cells(i, 2)
        Worksheets("作業").Cells(j, 2) = Worksheets("合体").Cells(i, 4)
        j = j + 1
    Next
'社員で並び替え
    Range(Cells(2, 1), Cells(lastrow, 2)).Select
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 1), SortOn _
    :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("作業").Sort
    .SetRange Range(Cells(2, 1), Cells(lastrow, 2))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
'社員計の計算
    j = 2
    Worksheets("社員計").Cells.Clear
    Worksheets("社員計").Cells(1, 1) = "社員"
    Worksheets("社員計").Cells(1, 2) = "金額"
    For i = 2 To lastrow
        kei = kei + Worksheets("作業").Cells(i, 2)
        If Worksheets("作業").Cells(i, 1) <> Worksheets("作業").Cells(i + 1, 1) Then
            Worksheets("社員計").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
            Worksheets("社員計").Cells(j, 2) = kei
            j = j + 1
            kei = 0
        End If
    Next
    Worksheets("社員計").Select
End Sub

給与奉行等が受け入れる形式でＣＳＶ出力をする。
Sub csv作成()
    Dim FileNamePath As Variant
    Dim ch1 As Long
    Dim lastrow As Long
    Dim i As Long
    Dim data(1) As String
    FileNamePath = "d:\自分のデータ\ikou.csv"
    Worksheets("社員計").Select
    lastrow = Worksheets("社員計").Cells(Rows.Count, 1).End(xlUp).Row
    ch1 = FreeFile
    Open FileNamePath For Output As #ch1
    For i = 2 To lastrow
        data(0) = Cells(i, 1)
        data(1) = Cells(i, 2)
        Print #ch1, data(0); ","; data(1)
    Next
    Close #ch1
    MsgBox "csvデータ作成できました"
    Worksheets("メニュー").Select
End Sub