見出し画像

ExcelVBAロボット。データを追加、書き直して！

qzou／Xで出来高急増！発信

前回は、ロボットにデータを集めてくることを行いました。
ポイントは
データを定型的に収集する作業と、データみて考えることを切り分ること。
そして、定型的でかつ繰り返すことはロボットにお願いしたいところです。

作業全体の流れのなかで

今回はシリーズの最後です。[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 Sub
Sub 注文書作成() 'ボタン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を見た」で良いです。
出来高急増！


この記事が気に入ったらサポートをしてみませんか？