大量の外貨建データを瞬時に為替計算！-チャットGPT4-に質問してVBAを使った自動化ツール

-チャットGPT4-

-チャットGPT4-に質問

ダイアログボックスで選択したファイルのSheet1からダイアログボックスで選択した別のファイルのBank Statement（編集用）R列のデータがUSDでF列がSheet1のC列が一致した時、Sheet1のE列の数値をQ列に、最終列の-13にI列に数値がある場合、=round(I列＊Q列,0)の式、 I列に数値がない場合、=round(H列＊Q列,0)の式を入れるVBAを作ってください。

-チャットGPT4-の回答

Option Explicit

Sub TransferDataWithMatchingCurrency()
    Dim SourceWorkbook As Workbook
    Dim TargetWorkbook As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim OpenFileName As Variant
    Dim LastRowSource As Long
    Dim LastRowTarget As Long
　　Dim LastColTarget As Long
    Dim i As Long, j As Long

    ' ソースファイルの選択
    OpenFileName = Application.GetOpenFilename _
        (Title:="ソースファイルを選択してください", _
        FileFilter:="Excel Files *.xls* (*.xls*),")
    If OpenFileName = False Then
        MsgBox "ファイルが選択されませんでした。", vbExclamation, "エラー"
        Exit Sub
    End If
    Set SourceWorkbook = Workbooks.Open(OpenFileName)

    ' ターゲットファイルの選択
    OpenFileName = Application.GetOpenFilename _
        (Title:="ターゲットファイルを選択してください", _
        FileFilter:="Excel Files *.xls* (*.xls*),")
    If OpenFileName = False Then
        MsgBox "ファイルが選択されませんでした。", vbExclamation, "エラー"
        Exit Sub
    End If
    Set TargetWorkbook = Workbooks.Open(OpenFileName)

    ' シートの設定
    Set wsSource = SourceWorkbook.Worksheets("Sheet1")
    Set wsTarget = TargetWorkbook.Worksheets("Bank Statement（編集用）")

    ' 最終行の取得
    LastRowSource = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
    LastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "F").End(xlUp).Row

　　
　　' ターゲットファイルの1行目の最終列を取得
    LastColTarget = wsTarget.Cells(1, wsTarget.Columns.Count).End(xlToLeft).Column
    ' データを転送
    For i = 2 To LastRowSource
        For j = 2 To LastRowTarget
            ' 条件が一致したらQ列に値を入れる
            If wsSource.Cells(i, "C").Value = wsTarget.Cells(j, "F").Value And wsTarget.Cells(j, "R").Value = "USD" Then
                wsTarget.Cells(j, "Q").Value = wsSource.Cells(i, "E").Value
                ' I列に数値がある場合、式を最終列の-13列目に入れる
                If Not IsEmpty(wsTarget.Cells(j, "I").Value) Then
                    wsTarget.Cells(j, LastColTarget - 13).Formula = "=ROUND(I" & j & "*Q" & j & ", 0)"
                ' I列に数値がない場合、式を最終列の-12列目に入れる
                Else
                    wsTarget.Cells(j, LastColTarget - 13).Formula = "=ROUND(H" & j & "*Q" & j & ", 0)"
                End If
               ' Exit For
            End If
        Next j
    Next i


   ' 完了メッセージを表示
    MsgBox "Bank Statement（編集用）シートのQ列と最終列-12列目が更新されました。", vbInformation, "完了"

End Sub