ChatGPT4に質問　VBAで複雑な条件式でデータを抽出して他の列のセルに代入

ChatGPT4に質問

VBAでダイアログボックスで選択したファイルのInvoice_details(編集用)シートのP列にソートを降順でかけて、P列のデータを支払日の列に代入、AT列を金額の列に代入、貸方消費税に対象外を代入、F列と（D列）を文字結合した値を摘要に代入して、E列がOAの時は、W列を摘要、未払金という文字列を勘定科目に代入、E列がHIEXPENSEの時は、【BH列】とW列を文字結合した値を摘要に未払金（立替精算）という文字列を勘定科目列に代入してください。

ChatGPT4の回答

Sub ProcessInvoiceDetails()

    Dim targetFile As Variant
    Dim targetWb As Workbook
    Dim targetWs As Worksheet
    Dim lastRow As Long
    Dim i As Long

    ' ダイアログボックスでファイルを選択
    targetFile = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm", Title:="対象のExcelファイルを選択してください")
    
    ' キャンセルボタンがクリックされた場合、処理を終了
    If targetFile = False Then Exit Sub

    ' 選択したファイルを開く
    Set targetWb = Workbooks.Open(targetFile)

    ' Invoice_details(編集用)シートを選択
    On Error Resume Next
    Set targetWs = targetWb.Worksheets("Invoice_details(編集用)")
    On Error GoTo 0

    If targetWs Is Nothing Then
        MsgBox "Invoice_details(編集用)シートが見つかりません。", vbCritical, "エラー"
        targetWb.Close SaveChanges:=False
        Exit Sub
    End If

   ' P列ソートを昇順に適用
    With targetWs.Sort
        .SortFields.Clear
        .SortFields.Add Key:=targetWs.Range("P2:P" & lastRow), Order:=xlAscending
        .SetRange targetWs.Range("A1:AT" & lastRow)
        .Header = xlYes
        .Apply
    End With

    ' 最終行を取得
    lastRow = targetWs.Cells(targetWs.Rows.Count, "P").End(xlUp).Row

    ' 指定された処理を実行
    For i = 2 To lastRow
        ' 支払日の列にP列のデータを代入
        targetWs.Cells(i, "PaymentDateColumn").Value = targetWs.Cells(i, "P").Value

        ' 金額の列にAT列のデータを代入
        targetWs.Cells(i, "AmountColumn").Value = targetWs.Cells(i, "AT").Value

        ' 貸方消費税に対象外を代入
        targetWs.Cells(i, "TaxColumn").Value = "対象外"

        ' 摘要にF列と（D列）を文字結合した値を代入
        targetWs.Cells(i, "DescriptionColumn").Value = targetWs.Cells(i, "F").Value & " (" & targetWs.Cells(i, "D").Value & ")"

        ' E列がOAの時
        If targetWs.Cells(i, "E").Value = "OA" Then
            targetWs.Cells(i, "SummaryColumn").Value = targetWs.Cells(i, "W").Value
            targetWs.Cells(i, "AccountColumn").Value = "未払金"

　　　　　　    ' E列がHIEXPENSEの時
    ElseIf targetWs.Cells(i, "E").Value = "HIEXPENSE" Then
        targetWs.Cells(i, "SummaryColumn").Value = targetWs.Cells(i, "BH").Value & targetWs.Cells(i, "W").Value
        targetWs.Cells(i, "AccountColumn").Value = "未払金（立替精算）"
    End If
Next i

' 保存してファイルを閉じる
targetWb.Save
targetWb.Close SaveChanges:=False

MsgBox "処理が完了しました。", vbInformation, "完了"

End Sub