-ChatGPT4-に質問 VBAで〇〇のデータが勘定科目変換マスタの条件と一致した場合、勘定科目と消費税を代入

-ChatGPT4-

-ChatGPT4-に質問

新しいVBAモジュールを作成してください。実行ファイルに立替精算勘定科目変換シートと一般経費勘定科目変換シートがあります。ダイアログボックスで選択したInvoice_details(編集用)シートもあります。立替精算勘定科目変換シートのA列と開いたInvoice_details(編集用)シートのBH列が一致した時、Invoice_details(編集用)シートの最終列のー9列目に立替精算勘定科目変換シートのB列をInvoice_details(編集用)シートの最終列のー7列目に立替精算勘定科目変換シートのC列を代入。一般経費勘定科目変換シートのA列と開いたInvoice_details(編集用)シートのF列が一致した時、Invoice_details(編集用)シートの最終列のー9列目に一般経費勘定科目変換シートのB列をInvoice_details(編集用)シートの最終列のー7列目に一般経費勘定科目変換シートのC列を代入。

ChatGPT4の回答

Sub UpdateInvoiceDetails()

    Dim wsReimburse As Worksheet
    Dim wsExpenses As Worksheet
    Dim wbInvoice As Workbook
    Dim wsInvoicedetails As Worksheet
    Dim fd As FileDialog
    Dim strFilePath As String
    Dim lRowInvoice As Long, lRowReimburse As Long, lRowExpenses As Long
    Dim lColInvoice As Long
    Dim i As Long, j As Long, k As Long

    ' 現在のワークブックのシートを設定
    Set wsReimburse = ThisWorkbook.Worksheets("立替精算勘定科目変換シート")
    Set wsExpenses = ThisWorkbook.Worksheets("一般経費勘定科目変換シート")

    ' ファイルピッカーダイアログボックスとしてFileDialogオブジェクトを作成
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    ' ダイアログボックスを表示
    If fd.Show = -1 Then
        ' 選択したファイルのパスを取得
        strFilePath = fd.SelectedItems(1)

        ' 選択したワークブックを開く
        Set wbInvoice = Workbooks.Open(strFilePath)

        ' Invoice_details(編集用)シートを設定
        On Error Resume Next
        Set wsInvoicedetails = wbInvoice.Worksheets("Invoice_details(編集用)")
        On Error GoTo 0

        If Not wsInvoicedetails Is Nothing Then
            ' 各シートの最終行を取得
            lRowInvoice = wsInvoicedetails.Cells(Rows.Count, "BH").End(xlUp).Row
            lRowReimburse = wsReimburse.Cells(Rows.Count, "A").End(xlUp).Row
            lRowExpenses = wsExpenses.Cells(Rows.Count, "A").End(xlUp).Row

            ' Invoice_detailsシートの最終列を取得
            lColInvoice = wsInvoicedetails.Cells(1, Columns.Count).End(xlToLeft).Column

            ' Invoice_detailsシートをループ
            For i = 2 To lRowInvoice
                ' 立替精算勘定科目変換シートをループ
                For j = 2 To lRowReimburse
                    If wsInvoicedetails.Cells(i, "BH").Value = wsReimburse.Cells(j, "A").Value Then
                        wsInvoicedetails.Cells(i, lColInvoice - 9).Value = wsReimburse.Cells(j, "B").Value
                        wsInvoicedetails.Cells(i, lColInvoice - 7).Value = wsReimburse.Cells(j, "C").Value
                    End If
                Next j

                ' 一般経費勘定科目変換シートをループ
                For k = 2 To lRowExpenses
                    If wsInvoicedetails.Cells(i, "F").Value = wsExpenses.Cells(k, "A").Value Then
                        wsInvoicedetails.Cells(i, lColInvoice - 9).Value = wsExpenses.Cells                       ( k, "B").Value
                        wsInvoicedetails.Cells(i, lColInvoice - 7).Value = wsExpenses.Cells(k, "C").Value
                    End If
                Next k
            Next i

            ' Invoice_detailsワークブックを保存して閉じる
            wbInvoice.Close SaveChanges:=True

        Else
            MsgBox "Invoice_details(編集用)シートが選択されたワークブックに見つかりません。"
        End If

    Else
        MsgBox "ファイルが選択されませんでした。"
    End If

End Sub

タイトルとURLをコピーしました