ExcelVBAロボット。データを追加、書き直して！
前回は、ロボットにデータを集めてくることを行いました。
ポイントは
データを定型的に収集する作業と、データみて考えることを切り分ること。
そして、定型的でかつ繰り返すことはロボットにお願いしたいところです。
作業全体の流れのなかで
今回はシリーズの最後です。[2022お歳暮]のシートを作り⇒「今年のお歳暮どうするか考え、決めて」⇒リスト仕上げ、注文書を作ります。
１．エクセルをこうして
２．データみて考え決める。それはあなた。
例えば、鈴木さん、過去のデータをみると、お中元はアイス、お歳暮は、ローストビーフかハムの詰め合わせの肉系、１万円ぐらいまでで、取引が深まったのでしょうか、少し値段上げてきています。
昨年はローストビーフだったので、今年はハムの詰め合わせ
（ハムの詰め合わせの行の緑の部分を、18行の場所にコピペ）
少し値段は上げて9000円にしました（金額のところを直し）
３．あとは、ロボットで。直すときはあなた。
(F)「2022お歳暮」シートに、データを追加します ボタン6
はい（Y）で追加した状態で保存 ※
いいえ（N）で保存しません→追加しません
※間違えて追加してまったり、後で変えたいときは ボタン7おすとファイルが開くので直して上書き保存すれば直せます。
(G)「2022お歳暮」シートのデータを読んで「注文書」シートに、データを転記します ボタン7
「注文書」シートで B2 にある 発注先 を読んで
「2022お歳暮」シート D列に ある場合 １５行目以下に 転記します。
２．コードをコピペ、ボタンを設定
Sub コピー先に追記() 'ボタン6に設定
Application.ScreenUpdating = False 'スクリーンOFF
Sheets("Sheet1").Select 'シートの選択
'このエクセルファイル名
a_name = ActiveWorkbook.Name
'ターゲットのフォルダ名とファイル名
pt = Range("C5") 'フォルダ名
fn = Range("D5") & Range("E5") 'ファイル名
t_fll = pt & "\" & fn 'ファイル名（フルパス）
'今回のシート名
new_sheet = Range("C10")
'コピーもと
t_name = Cells(18, 3)
sina = Cells(18, 4)
kin = Cells(18, 5)
saki = Cells(18, 6)
t_ad = Cells(18, 7)
tel = Cells(18, 8)
'ターゲットファイルが開いていたら閉じる()
On Error Resume Next
Open t_fll For Append As #1
Close #1
If Err.Number > 0 Then
Workbooks(fn).Activate
ActiveWorkbook.Close
Application.CutCopyMode = True
End If
'ターゲットファイルを開く
Workbooks.Open Filename:=t_fll
Sheets(new_sheet).Select
'最終行確認 →書き出し行 ＋1
maxRow = Range("A65536").End(xlUp).Row
gyo = maxRow + 1
'リスト行追加
Cells(gyo, 1) = t_name
Cells(gyo, 2) = sina
Cells(gyo, 3) = kin
Cells(gyo, 4) = saki
Cells(gyo, 5) = t_ad
Cells(gyo, 6) = tel
Rows(gyo).Select
Application.ScreenUpdating = True 'スクリーンON
rc = MsgBox("リスト追加して良いですか", vbYesNo + vbQuestion, "タイトルに表示する文字列")
If rc = vbYes Then
Cells(gyo, 1).Select
ActiveWorkbook.Close SaveChanges:=True
Else
Cells(gyo, 1).Select
ActiveWorkbook.Close SaveChanges:=False
End If
Sheets("Sheet1").Select 'シートの選択
End Sub
Sub コピー先を確認() 'ボタン7に設定
Application.ScreenUpdating = False 'スクリーンOFF
Sheets("Sheet1").Select 'シートの選択
'このエクセルファイル名
a_name = ActiveWorkbook.Name
'ターゲットのフォルダ名とファイル名
pt = Range("C5") 'フォルダ名
fn = Range("D5") & Range("E5") 'ファイル名
t_fll = pt & "\" & fn 'ファイル名（フルパス）
'今回のシート名
new_sheet = Range("C10")
'ターゲットファイルが開いていたら閉じる()
On Error Resume Next
Open t_fll For Append As #1
Close #1
If Err.Number > 0 Then
Workbooks(fn).Activate
ActiveWorkbook.Close
Application.CutCopyMode = True
End If
'ターゲットファイルを開く
Workbooks.Open Filename:=t_fll
Sheets(new_sheet).Select
Application.ScreenUpdating = True 'スクリーンON
End SubSub 注文書作成() 'ボタン8に設定
Application.ScreenUpdating = False 'スクリーンOFF
Sheets("Sheet1").Select 'シートの選択
'今回のシート名
new_sheet = Range("C10")
'このエクセルファイル名
a_name = ActiveWorkbook.Name
'ターゲットのフォルダ名とファイル名
pt = Range("C5") 'フォルダ名
fn = Range("D5") & Range("E5") 'ファイル名
t_fll = pt & "\" & fn 'ファイル名（フルパス）
'ターゲットファイルが開いていたら閉じる()
On Error Resume Next
Open t_fll For Append As #1
Close #1
If Err.Number > 0 Then
Workbooks(fn).Activate
ActiveWorkbook.Close
Application.CutCopyMode = True
End If
'ターゲットファイルを開く
Workbooks.Open Filename:=t_fll
On Error Resume Next
For Each sheet_name In Worksheets
If InStr(sheet_name.Name, "注文書") > 0 Then '-------------------★
Sheets(sheet_name.Name).Select
'前に書き出した一覧表クリア
maxRow = Range("B65536").End(xlUp).Row
If maxRow >= 15 Then
Range(Cells(15, 2), Cells(maxRow, 6)).Select
Selection.ClearContents
End If
Range("B15").Select
End If '---------------------------------------------------------★
Next
gyo1 = 15
gyo2 = 3
On Error Resume Next
For Each sheet_name In Worksheets
If InStr(sheet_name.Name, "注文書") > 0 Then '-------------------★
Sheets(sheet_name.Name).Select
saki = Range("B2")
Sheets(new_sheet).Select
Do While Cells(gyo2, 1) <> "" '--------------------------------loop
If Cells(gyo2, 4) = saki Then '
t_name = Cells(gyo2, 1)
sina = Cells(gyo2, 2)
kin = Cells(gyo2, 3)
t_ad = Cells(gyo2, 5)
tel = Cells(gyo2, 6)
Sheets(sheet_name.Name).Select
Cells(gyo1, 2) = t_name
Cells(gyo1, 3) = sina
Cells(gyo1, 4) = kin
Cells(gyo1, 5) = t_ad
Cells(gyo1, 6) = tel
gyo1 = gyo1 + 1
Sheets(new_sheet).Select
End If
gyo2 = gyo2 + 1
Loop '-----------------------------------------------------loop
gyo2 = 3
End If '---------------------------------------------------------★
gyo1 = 15
Next
'ターゲットファイルを閉じる
Dim wb As Workbook
For Each wb In Workbooks
If wb.Name = fn Then
Application.CutCopyMode = False
wb.Close SaveChanges:=True
Application.CutCopyMode = True
End If
Next
Sheets("Sheet1").Select 'シートの選択
Application.ScreenUpdating = True 'スクリーンON
End Sub
ズラッと並んで・・からの脱出！からそのあとは
今回で、シリーズの最後とします。しかし、記事を書いているなかで、あれも、これもと思いつくこと多くて・・・
せっかく書いたネタでもありますし、これをもとに次のことを書きたいと思っています。
①思いついたけど、脱線ぎみになるので、書かなかったことを注釈的というか、コードテクニック、より細かい点
②贈答品を送る仕事を設定して、説明しましたが、より大きい掴みというか、経験してきたことなど、より一般的に
不明点は、ご連絡いただいて結構です。
（すぐにとか、直接）お答えできないときはすみません。
note初心者なんで、noteのコミュニケートの方法よく分かりませんが ^^；
Twitterでも。どのツイートでも返信に「noteを見た」で良いです。
出来高急増！
この記事が気に入ったらサポートをしてみませんか？