-ChatGPT4-に質問　給与データを元にして給与仕訳を作成

2023.04.14

-ChatGPT4-

-ChatGPT4-に質問

VBAで給与仕訳を作成します。コメントは日本語にしてください。パスワードは解除し、ダイアログボックスでファイルを選択して、Sheet1の右隣にコピーして給与データと名前を変更する。給与データの最終行は、削除する。給与データの３行目から行データを取得して、給与仕訳テンプレート　のシートに代入していく。C列ーE列ーF列ーG列ーH列ーI列ーJ列ーK列の値を給与仕訳テンプレートのC１に代入、D列をC２列に代入、G列をC３に代入、F列をC4に代入、L列をC10とE10に代入、M列をC11とE11に代入、N列をC9とＥ9に代入、Ｏ列をＥ6に代入、Ｑ列をＥ7に代入、Ｒ列をＥ4に代入、Ｓ列をＥ3に代入、T列をE１に代入、U列をE2に代入、T列＋U列の値をJ１に代入。代入後のその給与仕訳テンプレートのシートをコピーして一番右に追加していく。シート名は、給与仕訳（部門：A列）としてください。

給与仕訳テンプレートのK列にある文字列の頭に○月度をつけるようにしてください。〇はインプットボックスで入力します。

ChatGPT4の回答

-ChatGPT4-による回答は完璧ではありませんので、多少の調整が必要です。

Sub CreateSalaryJournal()
    Dim wb As Workbook, wsData As Worksheet, wsTemplate As Worksheet
    Dim srcPath As String
    Dim lastRow As Long, i As Long
    Dim password As String
　　Dim month As String

    ' パスワードを設定
    password = "あなたのパスワード"

    ' ファイルを選択
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*"
        .Show
        srcPath = .SelectedItems(1)
    End With

    ' パスワードを解除してファイルを開き、Sheet1の内容をコピー
    Set wb = Workbooks.Open(srcPath, Password:=password)
    wb.Sheets("Sheet1").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

    ' 新しいシートに名前を付けて最終行を削除
    Set wsData = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    wsData.Name = "給与データ"
    lastRow = wsData.Cells(Rows.Count, 1).End(xlUp).Row
    wsData.Rows(lastRow).Delete

    ' テンプレートシートを準備
    Set wsTemplate = ThisWorkbook.Sheets("給与仕訳テンプレート")
　　' ○月度を取得
    month = InputBox("月度を入力してください（例：1月度の場合は、1）:", "月度の入力")
    ' データをコピーして入力
    For i = 3 To lastRow
        wsTemplate.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            .Name = "給与仕訳（部門：" & wsData.Cells(i, 1).Value & "）"
            .Cells(1, 3).Value = wsData.Cells(i, 3).Value-wsData.Cells(i, 5).Value-wsData.Cells(i, 6).Value-wsData.Cells(i, 7).Value-wsData.Cells(i, 8).Value-wsData.Cells(i, 9).Value-wsData.Cells(i, 10).Value-wsData.Cells(i, 11).Value
            .Cells(2, 3).Value = wsData.Cells(i, 4).Value
            .Cells(3, 3).Value = wsData.Cells(i, 7).Value
            .Cells(4, 3).Value = wsData.Cells(i, 6).Value
            .Cells(10, 3).Value = wsData.Cells(i, 12).Value
            .Cells(10, 5).Value = wsData.Cells(i, 12).Value
            .Cells(11, 3).Value = wsData.Cells(i, 13).Value
            .Cells(11, 5).Value = wsData.Cells(i, 13).Value
            .Cells(9, 3).Value = wsData.Cells(i, 14).Value
            .Cells(9, 5).Value = wsData.Cells(i, 14).Value
            .Cells(6, 5).Value = wsData.Cells(i, 15).Value
            .Cells(7, 5).Value = wsData.Cells(i, 17).Value
            .Cells(4, 5).Value = wsData.Cells(i, 18).Value
            .Cells(3, 5).Value = wsData.Cells(i, 19).Value
            .Cells(1, 5).Value = wsData.Cells(i, 20).Value
            .Cells(2, 5).Value = wsData.Cells(i, 21).Value
            .Cells(1, 10).Value = wsData.Cells(i, 20).Value + wsData.Cells(i, 21).Value
　　　　　　 ' 給与仕訳テンプレートのK列にある文字列の頭に○月度を追加
            Dim rowIndex As Long
            For rowIndex = 1 To 11
                .Cells(rowIndex, 11).Value = month & wsTemplate.Cells(rowIndex, 11).Value
            Next rowIndex
        End With
    Next i

    ' 元のファイルを保存せずに閉じる
    wb.Close SaveChanges:=False
End Sub
タイトルとURLをコピーしました