Excel VBA 逆引き集 | 処理対象シートを自動判定

Excel VBA
スポンサーリンク

ねらい：処理対象シートを「自動判定」して人手をゼロに

帳票名が毎回変わる、インポートファイルのシート順が一定でない、不要なシートが混ざる。こういう現場で手作業の選択はミスの温床です。自動判定の枠組みを用意して「どのシートを処理すべきか」をプログラムに決めさせましょう。初心者でも貼ってすぐ動くテンプレを、重要ポイントを深掘りして解説します。

  • 目的: 不要シートを除外し、必要シートだけを安全に処理。
  • 基本方針: 名前・タグ・データ量・ヘッダーの一致度でスコア化し、最良のシートを採用。複数条件で堅牢に。

基本戦略（優先度の考え方）

  • 優先1（強い手がかり）:
    • タグセル（例えば A1 に “INPUT”）、固定ヘッダー（1行目に特定の列名）、決め打ちシート名（“取込”など）。
  • 優先2（弱い手がかり）:
    • データ量（最終行や最終列）、Visible/Hidden、保護状態。
  • 判定の流れ:
    • 候補抽出→スコアリング→しきい値チェック→複数該当なら優先度比較→確定。
  • 重要深掘り:
    • 強い手がかりが最優先。 タグやヘッダー一致は誤判定が少ない。
    • 弱い手がかりは補助。 データ量が多いだけのシートは「集計」なども含みがちで危険。

テンプレ1：決め打ち名・部分一致で素早く判定（名前ベース）

Function FindSheetByNameExact(ByVal wb As Workbook, ByVal targetName As String) As Worksheet
    On Error Resume Next
    Set FindSheetByNameExact = wb.Worksheets(targetName)
    On Error GoTo 0
End Function

Function FindSheetByNameLike(ByVal wb As Workbook, ByVal keyword As String) As Worksheet
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        If InStr(1, ws.Name, keyword, vbTextCompare) > 0 Then
            Set FindSheetByNameLike = ws
            Exit Function
        End If
    Next
End Function

Sub Example_NameBased()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet
    
    Set ws = FindSheetByNameExact(wb, "取込") ' 完全一致
    If ws Is Nothing Then Set ws = FindSheetByNameLike(wb, "入力") ' 部分一致
    
    If ws Is Nothing Then
        MsgBox "対象シートが見つかりません。"
    Else
        MsgBox "対象シート: " & ws.Name
    End If
End Sub
VB
  • 重要深掘り:
    • 完全一致を先に試す→次に部分一致。 誤検知を減らす定石。
    • 可視性チェック併用が有効。 隠しシートやVeryHiddenは通常対象外にする。

テンプレ2：タグセルで確実に判定（A1 に “INPUT” など）

Function FindSheetByTagCell(ByVal wb As Workbook, ByVal addr As String, ByVal tagText As String) As Worksheet
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        If ws.Visible = xlSheetVisible Then
            If CStr(ws.Range(addr).Value) = tagText Then
                Set FindSheetByTagCell = ws
                Exit Function
            End If
        End If
    Next
End Function

Sub Example_TagCell()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = FindSheetByTagCell(wb, "A1", "INPUT")
    If ws Is Nothing Then
        MsgBox "タグ 'INPUT' のシートがありません。"
    Else
        MsgBox "対象シート: " & ws.Name
    End If
End Sub
VB
  • 重要深掘り:
    • タグは最強の手がかり。 人が見て分かるし、コードも簡潔。
    • タグ設計: A1に固定文字、別セルに版数など、複数タグで誤判定を更に減らせる。

テンプレ3：ヘッダー一致度で判定（列名が揃っているか）

Function HeaderMatchScore(ByVal ws As Worksheet, ByVal headerRow As Long, ByRef expected() As String) As Long
    Dim lastCol As Long: lastCol = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).Column
    Dim score As Long, c As Long, i As Long
    For i = LBound(expected) To UBound(expected)
        For c = 1 To lastCol
            If CStr(ws.Cells(headerRow, c).Value) = expected(i) Then
                score = score + 10: Exit For
            End If
        Next
    Next
    HeaderMatchScore = score
End Function

Function FindSheetByHeaderSet(ByVal wb As Workbook, ByRef expected() As String) As Worksheet
    Dim ws As Worksheet, best As Worksheet
    Dim bestScore As Long: bestScore = -1
    For Each ws In wb.Worksheets
        If ws.Visible = xlSheetVisible Then
            Dim s As Long: s = HeaderMatchScore(ws, 1, expected)
            If s > bestScore Then
                bestScore = s: Set best = ws
            End If
        End If
    Next
    Set FindSheetByHeaderSet = best
End Function

Sub Example_HeaderBased()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim expected() As String: expected = Split("社員番号,氏名,電話,入社日", ",")
    Dim ws As Worksheet: Set ws = FindSheetByHeaderSet(wb, expected)
    If ws Is Nothing Or HeaderMatchScore(ws, 1, expected) < 20 Then
        MsgBox "期待ヘッダーに一致するシートが見つかりません。"
    Else
        MsgBox "ヘッダー一致度トップ: " & ws.Name
    End If
End Sub
VB
  • 重要深掘り:
    • しきい値を設ける。 スコアが一定未満なら「対象外」として安全側に倒す。
    • 部分一致の導入: “社員番号”/“社員ID”などの同義語はスコア計算で配慮。

テンプレ4：データ量・可視性・保護状態で補助判定（弱い手がかり）

Function LastRowFast(ByVal ws As Worksheet, ByVal col As Variant) As Long
    LastRowFast = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
End Function

Function SheetDataScore(ByVal ws As Worksheet) As Long
    Dim lrA As Long: lrA = LastRowFast(ws, "A")
    Dim lrB As Long: lrB = LastRowFast(ws, "B")
    Dim lastRow As Long: lastRow = WorksheetFunction.Max(lrA, lrB)
    
    Dim visScore As Long: visScore = IIf(ws.Visible = xlSheetVisible, 10, -10)
    Dim protScore As Long: protScore = IIf(ws.ProtectContents, -5, 0)
    
    SheetDataScore = (lastRow \ 100) + visScore + protScore ' 行数で粗スコア
End Function
VB
  • 重要深掘り:
    • 行数スコアは補助に留める。 多い＝対象ではない。見出しだけのシートもあり得るため。
    • 可視性・保護はノイズ除去。 隠し/保護シートは基本対象外に。

テンプレ5：総合スコアリングで最良シートを自動確定

Function AutoDetectTargetSheet(ByVal wb As Workbook) As Worksheet
    Dim expected() As String: expected = Split("社員番号,氏名,電話,入社日", ",")
    Dim ws As Worksheet, best As Worksheet
    Dim bestScore As Long: bestScore = -100000
    
    For Each ws In wb.Worksheets
        Dim score As Long: score = 0
        
        ' 強い手がかり：タグ
        If CStr(ws.Range("A1").Value) = "INPUT" Then score = score + 100
        
        ' 強い手がかり：名前（部分一致）
        If InStr(1, ws.Name, "入力", vbTextCompare) > 0 Then score = score + 50
        If InStr(1, ws.Name, "取込", vbTextCompare) > 0 Then score = score + 40
        
        ' 強い手がかり：ヘッダー一致
        score = score + HeaderMatchScore(ws, 1, expected)
        
        ' 弱い手がかり：データ量・可視性・保護
        score = score + SheetDataScore(ws)
        
        ' ペナルティ：VeryHidden
        If ws.Visible = xlSheetVeryHidden Then score = score - 50
        
        If score > bestScore Then
            bestScore = score: Set best = ws
        End If
    Next
    
    ' しきい値（安全側）
    If best Is Nothing Or bestScore < 50 Then
        Set AutoDetectTargetSheet = Nothing
    Else
        Set AutoDetectTargetSheet = best
    End If
End Function

Sub Example_AutoDetect()
    Dim ws As Worksheet: Set ws = AutoDetectTargetSheet(ThisWorkbook)
    If ws Is Nothing Then
        MsgBox "対象シートを自動判定できませんでした。"
    Else
        MsgBox "自動判定の対象シート: " & ws.Name
    End If
End Sub
VB
  • 重要深掘り（ここが肝）:
    • 強い手がかりに大きな重み。 タグ・ヘッダー・名前キーワードが柱。
    • しきい値で誤判定防止。 スコアが低い場合は「未判定」として人の確認に切り替える。
    • 重みは現場仕様で調整。 例えばタグが絶対なら+200などに。

テンプレ6：判定結果をログ出力（透明性を確保）

Sub LogSheetScores()
    Dim ws As Worksheet, log As Worksheet
    Set log = Worksheets("Log")
    Dim r As Long: r = log.Cells(log.Rows.Count, "A").End(xlUp).Row + 1
    
    Dim expected() As String: expected = Split("社員番号,氏名,電話,入社日", ",")
    For Each ws In ThisWorkbook.Worksheets
        Dim s As Long
        s = 0
        If CStr(ws.Range("A1").Value) = "INPUT" Then s = s + 100
        s = s + HeaderMatchScore(ws, 1, expected)
        s = s + SheetDataScore(ws)
        
        log.Cells(r, 1).Value = Format(Now, "yyyy-mm-dd HH:NN:SS")
        log.Cells(r, 2).Value = ws.Name
        log.Cells(r, 3).Value = s
        r = r + 1
    Next
    MsgBox "判定スコアをLogシートへ出力しました。"
End Sub
VB
  • 重要深掘り:
    • 可視化で納得感。 スコアが見えると「なぜそのシート？」が説明できる。
    • チューニングに役立つ。 重みやしきい値の調整根拠になる。

例題で練習（貼って試せる）

  • 例1（タグ優先）:
    • 手順: “Input”シートのA1に“INPUT”と入れ、Example_TagCellで検出→AutoDetectに組み込む。
  • 例2（ヘッダー一致）:
    • 手順: 1行目に「社員番号,氏名,電話,入社日」を持つシートを作り、Example_HeaderBasedで一致度を確認。
  • 例3（名前部分一致）:
    • 手順: シート名に“入力”を含むシートでExample_NameBasedを実行。
  • 例4（総合判定）:
    • 手順: いくつかのシートを用意し、AutoDetectTargetSheetで最良が選ばれることを確認。
  • 例5（ログ出力）:
    • 手順: Logシートを作り、LogSheetScoresで各シートのスコアを一覧化。

実務の落とし穴と対策（重要ポイントの深掘り）

  • 落とし穴1：誤判定で別シートを処理
    • 対策: しきい値を設定し、低スコアは未判定扱い。初回はメッセージで確認させる。
  • 落とし穴2：ヘッダーの表記ゆれ
    • 対策: 同義語・部分一致・前後空白除去（Trim）で吸収。必要なら全角半角統一。
  • 落とし穴3：Invisible/VeryHiddenに潜むテストシート
    • 対策: Visibleのみを対象。必要時だけVeryHiddenも許可するフラグを用意。
  • 落とし穴4：データ量依存の誤判定
    • 対策: 行数スコアは補助に留め、タグやヘッダー一致で主判定。
  • 落とし穴5：運用でルールが増える
    • 対策: スコア項目を関数化し、重みをConfigで管理（数値だけ差し替えで運用変更）。

スターター手順（すぐ導入）

  • 手順1: テンプレ1・2を貼り、決め打ち名とタグセルでまず安定運用。
  • 手順2: テンプレ3（ヘッダー一致）を追加し、表記ゆれに強くする。
  • 手順3: テンプレ5（総合スコア）に統合し、しきい値で安全側へ。
  • 手順4: テンプレ6でログ化し、重み調整の材料を作る。

スポンサーリンク
タイトルとURLをコピーしました