クレジットカードの利用履歴(CSV)を自動でExcelファイルにコピペして記録するためのマクロを作成

クレジットカードの利用履歴を一つのExcelファイルにまとめたいと思ってマクロを作って見ました。

サイトからCSVをダウンロードすればその中身を用意しておいた別のExcelファイルにコピペすることができます。

Sub データ追加()

Dim path, idemitsu_card, file, nengetsu, csvfile_path As String
Dim csvfile As Workbook
Dim lastrow, lastcolumn, lastrow2, lastrow3, i As Integer

path = ThisWorkbook.path & “\”
idemitsu_card = “出光カード.xlsm”

Application.ScreenUpdating = False

‘ファイル名(拡張子なし)を指定し年月(nengetsu)を取得
file = InputBox(“CSVファイル名を入力(拡張子は入力しない)” & vbCr & “例:IDEMITSU_2108”, “CSVファイル名”)
‘IDEMITSU_2108
nengetsu = Right(file, 4)

‘処理済みかどうか判定(A1セルの年月がファイル名と一致した場合は処理済み)
If Workbooks(idemitsu_card).Worksheets(“Sheet1”).Cells(1, 1).Text <> nengetsu Then

‘csvファイルを開く
csvfile_path = path & file & “.csv”
Workbooks.Open csvfile_path

‘csvファイルの内容をコピー
Set csvfile = ActiveWorkbook
csvfile.ActiveSheet.Cells(6, 2).Select
lastrow = ActiveCell.End(xlDown).Row
lastcolumn = 7
Range(Cells(6, 1), Cells(lastrow, lastcolumn)).Copy

‘貼り付け
Workbooks(idemitsu_card).Activate
lastrow2 = Cells(3, 1).End(xlDown).Row + 1
Cells(lastrow2, 1).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
’17

‘csvファイルを閉じる
Workbooks(file & “.csv”).Close

‘処理年月を上書き
Workbooks(idemitsu_card).ActiveSheet.Cells(1, 1) = nengetsu

‘追加したデータのA列に空欄があれば前の行の値をコピペ
lastrow3 = ActiveCell.Offset(0, 1).End(xlDown).Row
i = ActiveCell.Row

Do Until i = lastrow3
If Cells(i, 1).Text = “” Then
Cells(i, 1).Offset(-1, 0).Copy
Cells(i, 1).PasteSpecial (xlPasteAll)
i = i + 1

Else
i = i + 1

End If
Loop

Else
MsgBox “既に処理済み”
Cells(1, 1).Select

End If

Application.ScreenUpdating = True

End Sub

コメント

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