【VBA】パラメタを変えてスクリプトを大量生成

久々にVBA

R、PythonSAS ... なんでも良いが、
共有ロジックを外部ファンクションや外部マクロにしておいて、 パラメタを変えてぐるぐる回すことがある。
例えば、疾患名を変えて患者数を推移図にするなど。

そんなとき、スクリプトをいちいち作っていると面倒だし、ミスにもつながる。

だからVBAで一括生成してしまおうというお話。


こんな感じでエクセルに情報を埋めて、
f:id:cochineal19:20210828145754p:plain:w400

VBAコードを仕込んで実行すると、

Sub OutputScript()
'---------------------------------------
' 設定
'---------------------------------------
    On Error GoTo ERROR1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Dim myWB As Workbook, myWS As Worksheet
    Dim strow, enrow, encol, fnumber, i As Long
    Dim outpath As String
    
    Set myWB = ThisWorkbook
    Set myWS = myWB.Sheets(ActiveSheet.Name)
    
    strow = 7
    enrow = myWS.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    
    outpath = myWS.Cells(3, 3)
    If outpath = "" Then outpath = myWB.Path
    
'---------------------------------------
' テキスト生成
'---------------------------------------
    For i = strow To enrow
    
        fnumber = FreeFile
        
        Open outpath & "\" & myWS.Cells(i, 2) For Output As #fnumber
        
        Print #fnumber, "#==============================================================================="
        Print #fnumber, "# ファイル名 : " & myWS.Cells(i, 2)
        Print #fnumber, "# 作  成  日 : " & Format(Now(), "yyyy/mm/dd")
        Print #fnumber, "# 作  成  者 : " & myWS.Cells(4, 3)
        Print #fnumber, "#==============================================================================="
        Print #fnumber, "#-------------------------------------------------------------------------------"
        Print #fnumber, "# 設定"
        Print #fnumber, "#-------------------------------------------------------------------------------"
        Print #fnumber, "library(tidyverse)"
        Print #fnumber, "setwd(パスを入力)"
        Print #fnumber, ""
        Print #fnumber, "#-------------------"
        Print #fnumber, "# ロード"
        Print #fnumber, "#-------------------"
        Print #fnumber, "Source('./myFunctionX.r')"
        Print #fnumber, ""
        Print #fnumber, "#-------------------"
        Print #fnumber, "# 実行"
        Print #fnumber, "#-------------------"
        Print #fnumber, "myFunctionX(PARAM1='" & myWS.Cells(i, 3) & "', PARAM2=" & myWS.Cells(i, 4) & ")"
        Print #fnumber, ""
        Print #fnumber, "#-------------------------------------------------------------------------------"
        Print #fnumber, "# End of File"
        Print #fnumber, "#-------------------------------------------------------------------------------"
        
        Close #fnumber

    Next i
    
    myWS.Cells(1, 1).Select
    MsgBox "出力しました"
    
    GoTo END1

'---------------------------------------
' 後始末
'---------------------------------------
ERROR1:
    MsgBox Err.Number & ":" & Err.Description
    
END1:
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set myWB = Nothing
    Set myWS = Nothing

End Sub


一気にスクリプトが生成される(今回はRスクリプト)。
f:id:cochineal19:20210828145957p:plain:w350

スクリプトの中身はこんな感じ。外部ファンクションへの指定パラメタをスクリプト毎に変えて生成している。
f:id:cochineal19:20210828150239p:plain:w550
f:id:cochineal19:20210828150319p:plain:w550

これで少し楽ができる。めでたし、めでたし。

本ブログは個人メモです。 本ブログの内容によって生じた損害等の一切の責任を負いかねますのでご了承ください。