建設大臣NXの受入処理機能を使用してCSVデータをインポートする際に指定した摘要がある仕訳データの下に新規の仕訳を1行追加するマクロ

Sub kensetu_add2()

'■【マクロの説明】
'建設大臣のインポート用データで摘要欄から指定したキーワードを検索して空白行を追加し、
'仕訳を1行追加挿入するマクロ

'■変数宣言

Dim targetrng As Range
Dim startrng As Range
Dim endrng As Range
Dim targetrow As Long
Dim findword As String

findword = "※※※"  'ここに検索するキーワードを入力する。

'■変数宣言（配列）

Dim data_add(43) As Variant


'■処理実行部分


Set targetrng = Range("ar:ar").Find(what:=findword, lookat:=xlWhole)

    
If targetrng Is Nothing Then

    MsgBox "『" & findword & "』という摘要はありませんでしたので終了します。", vbInformation
    Exit Sub
    
Else
    
    Set startrng = targetrng
    
    targetrow = targetrng.Row  '摘要が見つかった「行」の番号を変数に格納する
    
    '■新規行の追加
    
     targetrng.EntireRow.Offset(1, 0).Insert
     targetrng.EntireRow.Offset(1, 0).Interior.ColorIndex = 4
    
    '■1行目の追加する仕訳の項目を設定して配列data_addに格納する。
    
    
    data_add(0) = targetrng.Offset(0, -43).Value  '年
    data_add(1) = targetrng.Offset(0, -42).Value  '月
    data_add(2) = targetrng.Offset(0, -41).Value  '日
    data_add(3) = targetrng.Offset(0, -40).Value  '伝票NO
    data_add(8) = 333  '借方コード
    data_add(10) = "他勘定科目振替"  '借方科目名
    data_add(13) = 0   '借方税区分
    data_add(16) = 1280  '借方金額
    data_add(21) = 999  '貸方コード
    data_add(23) = "諸口"  '貸方科目名
    data_add(26) = 0  '貸方税区分
    data_add(29) = data_add(16)   '貸方金額
    data_add(43) = "仕訳を1行追加しました"  '摘要

  
    '■仕訳の追加
    
    Range("a" & targetrow, "ar" & targetrow).Offset(1, 0).Value = data_add
    
End If

　'■作業の繰り返し
Do
    
    Set targetrng = Range("ar:ar").FindNext(targetrng)
    
    If targetrng.Address = startrng.Address Then
    
        Exit Do
    
    Else
    
        targetrow = targetrng.Row  '摘要が見つかった「行」の番号を変数に格納する
    
        '■新規行の追加
        
             targetrng.EntireRow.Offset(1, 0).Insert
            targetrng.EntireRow.Offset(1, 0).Interior.ColorIndex = 4
    
        
        '■1行目の追加する仕訳の日付を再取得して配列data_addに格納する。
    
        data_add(2) = targetrng.Offset(0, -41).Value    '日付
    
        '■2行目の追加する仕訳の日付を再取得して配列data_addに格納する。
    
        data_add(2) = data_add(2)    '日付

      '■仕訳の追加
    
        Range("a" & targetrow, "ar" & targetrow).Offset(1, 0).Value = data_add
        
    End If
    
Loop
    
MsgBox "『" & findword & "』仕訳の追加作業が完了しました。", vbInformation

End Sub