VBScriptでExcelの日付条件データ取得①(C列のみ)

今回は過去に HTA からコード作成を行った際にうまく進められなかった経験を踏まえて作業の進め方を見直し、HTA を起点と
するのではなく VBScript のコードを直接作成する方法で進めていきます。
１．前提作業
業務効率化ツールを動作させるためには、事前にいくつかの Excel ファイルを準備しておく必要があります。
1-1．サーバー管理台帳のイメージ
サーバー管理台帳は見出し行が 3 行目に配置されており、実際のデータは 4 行目から 41 行目まで入力されている状態に
しておいてください。さらにコード実行前の準備としてファイルを保存する前に「2025/12/25」の日付でフィルタを設定しておいてください。
このフィルタ設定によりVBScript 側で取得されるデータが限定され、想定どおりの動作確認が行いやすくなります。

1-2．実行環境作業手続き申請書のイメージ
基本的には「改訂履歴」となっている 1 番目のシートのみを用意して頂ければ問題ありませんが、VBScript のコードを実際に
検証する場合には「作業手続き申請書」となっている 2 番目のシートが存在している必要があります。
さらに、この 2 番目のシートについては、あらかじめ想定している列構成と一致していないとVBScript による Excel 操作が
正しく動作しませんのでご注意ください。
VBScriptが実行後はH列28行目から該当したものが出力されるようにあっております。

1-3．VBScript実行後のイメージ
VBScript を実行するとサーバー管理台帳の内容を参照し、指定した条件に一致する日付のデータが存在する場合はその情報が
自動的に取得されてH 列および M 列に表示される仕組みとなっています。
今回の例では、サーバー管理台帳において「2025/12/25」でフィルタが設定されている状態を前提としています。

２．実行処理とファイルの保存方法
①ソースコードはこちらをご覧にくださいとをクリックして頂けますとコードが表示されますので
メモ長を起動して貼り付けてください。管理者権限じゃなくても普通に起動してください
②デフォルトの拡張子(.txt)からVBScriptの拡張子(.vbs)をクリック変更してください。
その前の表示はファイル名なのでご自身で好きに決めてください。

'========================================================================
' 変数の設定
'========================================================================
Dim basePath, srcPath, outPath

Dim xlApp, srcBook, srcSheet, outBook, outSheet

Dim targetDate, dataStartRow, lastRow, outRow, r, hitcount

Dim targetText, i

Dim startCopyRow, pasteRow, j

'========================================================================
' 参照元と出力先のファイルの指定してファイルを開く
'========================================================================
basePath = "C:\Users\sasio-tech.SASIO.JP\Documents\作業申請ツール"
srcPath  = basePath & "\sample_001.xlsx"
outPath  = basePath & "\sample_002.xlsx"

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
xlApp.DisplayAlerts = False

Set srcBook = xlApp.Workbooks.Open(srcPath)
Set srcSheet = srcBook.Sheets(1)

Set outBook = xlApp.Workbooks.Open(outPath)
Set outSheet = outBook.Sheets(2)

'========================================================================
' オートフィルタの設定を確認する
'========================================================================
Const xlCellTypeVisible = 12
Const xlUp = -4162

' サンプルコードのための動作確認のため日付を「2025/12/25」を固定化
targetDate = "2025/12/25"
dataStartRow = 4

If srcSheet.AutoFilterMode = False Then
    MsgBox "オートフィルタが設定されていません。"
    srcBook.Close False
    outBook.Close False
    xlApp.Quit
    WScript.Quit
End If

srcSheet.Range("A4").AutoFilter 7, "*" & targetDate & "*"

On Error Resume Next
srcSheet.Range("G4:G41").SpecialCells xlCellTypeVisible
If Err.Number <> 0 Then
    MsgBox "対象日付のデータがありません。"
    Err.Clear
    srcBook.Close False
    outBook.Close False
    xlApp.Quit
    WScript.Quit
End If
On Error GoTo 0

lastRow = srcSheet.Cells(srcSheet.Rows.Count, "G").End(xlUp).Row

'========================================================================
' 参照元ファイルのC列から出力先ファイルのH列に出力する処理
'========================================================================
hitcount = 0
outRow = 28

For r = dataStartRow To lastRow
    If srcSheet.Rows(r).Hidden = False Then
        If Trim(srcSheet.Cells(r, "G").Value) <> "" Then

            'H列にサーバー管理番号を出力
            outSheet.Cells(outRow, "H").Value = srcSheet.Cells(r, "C").Value

            'M列にサーバー名を出力
            outSheet.Cells(outRow, "M").Value = srcSheet.Cells(r, "C").Value

            'X列に「作業実施日/開始時間」を出力
            outSheet.Cells(outRow, "R").Value = srcSheet.Cells(r, "G").Value
            outSheet.Cells(outRow+1, "R").Value = "9時00分"

            outRow = outRow + 2
            hitcount = hitcount + 1
        End If
    End If
Next

srcBook.Close False
outBook.Save
outBook.Close
xlApp.Quit

ソースコードはこちらをご確認ください+