Excel VBA | 「実務で本当に使う」レベルの ByRef 活用サンプル

VBA

2010.06.262025.11.20

ここでは 「ログ出力」「エラー処理」「進捗バー」 をすべて組み込んだ、
Excel VBA の 完全業務テンプレ（参照渡し／ByRef 対応版） を提示します。

【完全版】実務テンプレ（ファイル操作 + 日付処理 + 検索処理 + 進捗バー + ログ + エラー処理 + ByRef）
シート構成（推奨）
完成版フルテンプレコード
完成！

【完全版】実務テンプレ（ファイル操作 + 日付処理 + 検索処理 + 進捗バー + ログ + エラー処理 + ByRef）

以下のような “本物の業務マクロ構成” を作ります。

シート構成（推奨）

[Menu]      … メインボタン（任意）
[Data]      … データ読み込み＆検索結果
[Log]       … ログ
[Config]    … 設定シート（フォルダ・検索キーワード）
[Progress]  … 進捗バー表示用

完成版フルテンプレコード

（標準モジュールに貼れば動きます。進捗バー用は後ろに記述）

Module1 : Main（メイン処理）

Option Explicit

Sub MainProcess()

    On Error GoTo ERR_HANDLE
    
    Dim folder As String, keyword As String
    Dim filePath As String
    Dim startTime As Date, endTime As Date
    Dim rngImport As Range
    Dim newName As String
    
    startTime = Now
    Call LogWrite("=== 処理開始 ===")
    
    ' 進捗バー初期化
    Call Progress_Init("処理開始中...", 5)

    ' 設定読込（ByRef）
    Call LoadConfig(ByRef folder, ByRef keyword)
    Call Progress_Update(1, "設定読込完了")

    ' 最新CSV取得
    filePath = GetLatestCSV(folder)
    If filePath = "" Then
        Call RaiseAndLogError("CSVファイルが見つかりません。")
        Exit Sub
    End If
    Call Progress_Update(2, "CSVファイル選択：" & filePath)

    ' CSV読込（ByRef Range）
    Set rngImport = Sheets("Data").Range("A1")
    Call ImportCSV(ByRef filePath, ByRef rngImport)
    Call Progress_Update(3, "CSV読込完了")

    ' 検索処理（ByRef）
    Call ProcessSearch(ByRef keyword)
    Call Progress_Update(4, "検索処理完了（keyword=" & keyword & "）")

    ' シート名変更
    newName = "処理完了_" & Format(Date, "yyyymmdd")
    Call RenameSheet(Sheets("Data"), ByRef newName)
    Call Progress_Update(5, "シート名変更 → " & newName)

    ' 完了ログ
    endTime = Now
    Call LogWrite("=== 正常終了：" & startTime & " → " & endTime & " ===")
    
    Call Progress_Finish("処理が完了しました！")
    MsgBox "処理完了", vbInformation

    Exit Sub

'---------------------------------------------
' エラー処理
'---------------------------------------------
ERR_HANDLE:
    Call RaiseAndLogError("エラー：" & Err.Description)
End Sub

Option Explicit

Sub MainProcess()

    On Error GoTo ERR_HANDLE
    
    Dim folder As String, keyword As String
    Dim filePath As String
    Dim startTime As Date, endTime As Date
    Dim rngImport As Range
    Dim newName As String
    
    startTime = Now
    Call LogWrite("=== 処理開始 ===")
    
    ' 進捗バー初期化
    Call Progress_Init("処理開始中...", 5)

    ' 設定読込（ByRef）
    Call LoadConfig(ByRef folder, ByRef keyword)
    Call Progress_Update(1, "設定読込完了")

    ' 最新CSV取得
    filePath = GetLatestCSV(folder)
    If filePath = "" Then
        Call RaiseAndLogError("CSVファイルが見つかりません。")
        Exit Sub
    End If
    Call Progress_Update(2, "CSVファイル選択：" & filePath)

    ' CSV読込（ByRef Range）
    Set rngImport = Sheets("Data").Range("A1")
    Call ImportCSV(ByRef filePath, ByRef rngImport)
    Call Progress_Update(3, "CSV読込完了")

    ' 検索処理（ByRef）
    Call ProcessSearch(ByRef keyword)
    Call Progress_Update(4, "検索処理完了（keyword=" & keyword & "）")

    ' シート名変更
    newName = "処理完了_" & Format(Date, "yyyymmdd")
    Call RenameSheet(Sheets("Data"), ByRef newName)
    Call Progress_Update(5, "シート名変更 → " & newName)

    ' 完了ログ
    endTime = Now
    Call LogWrite("=== 正常終了：" & startTime & " → " & endTime & " ===")
    
    Call Progress_Finish("処理が完了しました！")
    MsgBox "処理完了", vbInformation

    Exit Sub

'---------------------------------------------
' エラー処理
'---------------------------------------------
ERR_HANDLE:
    Call RaiseAndLogError("エラー：" & Err.Description)
End Sub

Module2：Config 読み込み（ByRef）

Sub LoadConfig(ByRef folder As String, ByRef keyword As String)
    With Sheets("Config")
        folder = .Range("B1").Value
        keyword = .Range("B2").Value
    End With
    Call LogWrite("設定読み込み：folder=" & folder & ", keyword=" & keyword)
End Sub

Sub LoadConfig(ByRef folder As String, ByRef keyword As String)
    With Sheets("Config")
        folder = .Range("B1").Value
        keyword = .Range("B2").Value
    End With
    Call LogWrite("設定読み込み：folder=" & folder & ", keyword=" & keyword)
End Sub

Module3：ファイル操作（最新 CSV 取得）

Function GetLatestCSV(ByVal folder As String) As String

    Dim f As String, target As String
    Dim newestTime As Date

    f = Dir(folder & "\*.csv")
    Do While f <> ""
        If FileDateTime(folder & "\" & f) > newestTime Then
            target = folder & "\" & f
            newestTime = FileDateTime(target)
        End If
        f = Dir()
    Loop

    If target <> "" Then Call LogWrite("最新CSV取得：" & target)
    GetLatestCSV = target
End Function

Function GetLatestCSV(ByVal folder As String) As String

    Dim f As String, target As String
    Dim newestTime As Date

    f = Dir(folder & "\*.csv")
    Do While f <> ""
        If FileDateTime(folder & "\" & f) > newestTime Then
            target = folder & "\" & f
            newestTime = FileDateTime(target)
        End If
        f = Dir()
    Loop

    If target <> "" Then Call LogWrite("最新CSV取得：" & target)
    GetLatestCSV = target
End Function

Module4：CSV 読込（Range を参照渡し／ByRef）

Sub ImportCSV(ByRef filePath As String, ByRef rng As Range)

    rng.CurrentRegion.Clear

    With rng.Parent.QueryTables.Add( _
        Connection:="TEXT;" & filePath, _
        Destination:=rng)
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With

    Call LogWrite("CSV読込完了：" & filePath)
End Sub

Sub ImportCSV(ByRef filePath As String, ByRef rng As Range)

    rng.CurrentRegion.Clear

    With rng.Parent.QueryTables.Add( _
        Connection:="TEXT;" & filePath, _
        Destination:=rng)
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With

    Call LogWrite("CSV読込完了：" & filePath)
End Sub

Module5：検索処理（セル値を書き換え）

Sub ProcessSearch(ByRef keyword As String)

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, cnt As Long

    Set ws = Sheets("Data")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
        If InStr(ws.Cells(i, 1).Value, keyword) > 0 Then
            ws.Cells(i, 3).Value = "ヒット"
            ws.Cells(i, 4).Value = Date
            cnt = cnt + 1
        End If
    Next i

    Call LogWrite("検索処理：" & keyword & " / ヒット " & cnt & " 件")
End Sub

Sub ProcessSearch(ByRef keyword As String)

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, cnt As Long

    Set ws = Sheets("Data")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
        If InStr(ws.Cells(i, 1).Value, keyword) > 0 Then
            ws.Cells(i, 3).Value = "ヒット"
            ws.Cells(i, 4).Value = Date
            cnt = cnt + 1
        End If
    Next i

    Call LogWrite("検索処理：" & keyword & " / ヒット " & cnt & " 件")
End Sub

Module6：シート名変更（ByRef）

Sub RenameSheet(ByRef ws As Worksheet, ByRef newName As String)
    On Error Resume Next
    ws.Name = newName
    On Error GoTo 0
    
    Call LogWrite("シート名変更：" & newName)
End Sub

Sub RenameSheet(ByRef ws As Worksheet, ByRef newName As String)
    On Error Resume Next
    ws.Name = newName
    On Error GoTo 0
    
    Call LogWrite("シート名変更：" & newName)
End Sub

Module7：ログ出力

Sub LogWrite(msg As String)
    Dim ws As Worksheet
    Dim r As Long

    Set ws = Sheets("Log")
    r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

    ws.Cells(r, 1).Value = Now
    ws.Cells(r, 2).Value = msg
End Sub

Sub LogWrite(msg As String)
    Dim ws As Worksheet
    Dim r As Long

    Set ws = Sheets("Log")
    r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

    ws.Cells(r, 1).Value = Now
    ws.Cells(r, 2).Value = msg
End Sub

Module8：エラー処理（ログ出力 + メッセージ表示）

Sub RaiseAndLogError(ByVal msg As String)
    Call LogWrite("ERROR: " & msg)
    Call Progress_Finish("エラーが発生しました")
    MsgBox msg, vbCritical
End Sub

Sub RaiseAndLogError(ByVal msg As String)
    Call LogWrite("ERROR: " & msg)
    Call Progress_Finish("エラーが発生しました")
    MsgBox msg, vbCritical
End Sub

Module9：進捗バー（Progress シート利用）

Progress シートの構成（必須）

A1	B1
Bar	（進捗バー用のセル）

そのセルに背景色でバーを表示します。

進捗バー初期化

Sub Progress_Init(message As String, ByVal maxStep As Long)
    With Sheets("Progress")
        .Range("A2").Value = message
        .Range("B1").Interior.ColorIndex = 2 '白
    End With
    Sheets("Progress").Range("D1").Value = maxStep
End Sub

Sub Progress_Init(message As String, ByVal maxStep As Long)
    With Sheets("Progress")
        .Range("A2").Value = message
        .Range("B1").Interior.ColorIndex = 2 '白
    End With
    Sheets("Progress").Range("D1").Value = maxStep
End Sub

進捗バー更新

Sub Progress_Update(ByVal step As Long, Optional message As String = "")
    Dim maxStep As Long
    maxStep = Sheets("Progress").Range("D1").Value
    
    Dim pct As Double
    pct = step / maxStep

    ' バー描画
    With Sheets("Progress").Range("B1")
        .Interior.ColorIndex = 4 ' 緑
        .ColumnWidth = 30 * pct
    End With

    If message <> "" Then
        Sheets("Progress").Range("A2").Value = message
    End If
End Sub

Sub Progress_Update(ByVal step As Long, Optional message As String = "")
    Dim maxStep As Long
    maxStep = Sheets("Progress").Range("D1").Value
    
    Dim pct As Double
    pct = step / maxStep

    ' バー描画
    With Sheets("Progress").Range("B1")
        .Interior.ColorIndex = 4 ' 緑
        .ColumnWidth = 30 * pct
    End With

    If message <> "" Then
        Sheets("Progress").Range("A2").Value = message
    End If
End Sub

完了

Sub Progress_Finish(msg As String)
    With Sheets("Progress")
        .Range("A2").Value = msg
        .Range("B1").Interior.ColorIndex = 4
        .Range("B1").ColumnWidth = 30
    End With
End Sub

Sub Progress_Finish(msg As String)
    With Sheets("Progress")
        .Range("A2").Value = msg
        .Range("B1").Interior.ColorIndex = 4
        .Range("B1").ColumnWidth = 30
    End With
End Sub