ねらい：大規模でも「貼って動く」テンプレを共通ライブラリ化し、拡張しても壊れない運用へ
規模が大きくなるほど、関数やモジュールの“型”が揃っているかが品質と速度を左右します。ここでは、大規模エクセルに必要な基盤（開始・終了枠、設定、ログ、配列I/O、ソート、辞書ユーティリティ、UUID、ZIP、ハッシュ、差分、スケジューラ、テスト）をライブラリとして提供します。初心者でも貼って動く最小コードに加え、重要部分は深掘りして「なぜそう設計するか」まで丁寧に説明します。
ライブラリの構成と導入ガイド
モジュール構成（役割で分ける）
- ModApp（開始・終了枠）
- ModConfig（設定読み込み）
- ModLog（ログ出力）
- IO_Sheet（Range⇔配列I/O）
- UTIL_Array（配列ツール：ソート・Distinct・結合）
- UTIL_Text（正規化・比較）
- UTIL_Dict（ハッシュマップ高速化）
- UTIL_Hash（SHA-256・CRC）
- UTIL_Diff（差分アルゴリズム）
- UTIL_Zip（圧縮・展開）
- UTIL_Uuid（UUID生成）
- ModScheduler（OnTimeスケジューラ）
- ModTest（テスト基盤）
重要ポイントの深掘り
- 役割ごとにモジュールを分けると、変更範囲が明確になり“影響範囲の見通し”が良くなります。
- 参照設定不要（Late Binding）の方針で統一すると、配布先で動かない事故が激減します。
- すべて“配列中心”で処理し、最後だけシートへ一括書き戻すのが速度の核心です。
基盤テンプレ：開始・終了、設定、ログ
開始・終了枠（必ず復帰）
' ModApp.bas
Option Explicit
Public Sub AppEnter(Optional ByVal status As String = "")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Len(status) > 0 Then Application.StatusBar = status
End Sub
Public Sub AppLeave()
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
設定読み込み（INI風）
' ModConfig.bas
Option Explicit
Private gCfg As Object
Public Sub LoadConfig(Optional ByVal path As String = "")
Set gCfg = CreateObject("Scripting.Dictionary")
If path = "" Then path = ThisWorkbook.Path & "\config.ini"
If Dir(path, vbNormal) = "" Then Exit Sub
Dim h As Integer: h = FreeFile, line As String
Open path For Input As #h
Do While Not EOF(h)
Line Input #h, line: line = Trim$(line)
If Len(line) > 0 And Left$(line, 1) <> "#" And InStr(line, "=") > 0 Then
gCfg(LCase$(Split(line, "=")(0))) = Trim$(Split(line, "=")(1))
End If
Loop
Close #h
End Sub
Public Function Cfg(ByVal key As String, Optional ByVal defVal As String = "") As String
If gCfg Is Nothing Then LoadConfig
key = LCase$(key)
Cfg = IIf(gCfg.Exists(key), gCfg(key), defVal)
End Function
ログ（日別CSV＋安全なエスケープ）
' ModLog.bas
Option Explicit
Public Sub Log(ByVal level As String, ByVal category As String, ByVal msg As String)
On Error Resume Next
Dim dir As String: dir = ThisWorkbook.Path & "\logs": If Dir(dir, vbDirectory) = "" Then MkDir dir
Dim f As String: f = dir & "\" & Format(Date, "yyyy-mm-dd") & ".csv"
Dim h As Integer: h = FreeFile
Open f For Append As #h
Print #h, Safe("ts", Format(Now, "yyyy-mm-dd HH:NN:SS")) & "," & _
Safe("lvl", level) & "," & Safe("cat", category) & "," & Safe("msg", msg)
Close #h
On Error GoTo 0
End Sub
Private Function Safe(ByVal k As String, ByVal v As String) As String
Safe = """" & Replace(Replace(v, """", "'"), ",", " ") & """"
End Function
重要ポイントの深掘り
- 開始・終了枠は“例外でも必ず復帰”が目的。これがない設計は現場で必ず壊れます。
- 設定外出しで「パス・閾値・モード」をノンコーディング化。保守性が一気に上がります。
- ログは固定フォーマット（時刻・レベル・カテゴリ・メッセージ）で“後から読める・機械も読める”ことを保証します。
I/Oと配列ユーティリティ：速度の核を揃える
Range⇔配列の一括I/O
' IO_Sheet.bas
Option Explicit
Public Function ReadRegion(ByVal ws As Worksheet, Optional ByVal topLeft As String = "A1") As Variant
ReadRegion = ws.Range(topLeft).CurrentRegion.Value
End Function
Public Sub WriteRegion(ByVal ws As Worksheet, ByVal a As Variant, Optional ByVal topLeft As String = "A1")
ws.Range(topLeft).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub
安定ソート（多列は後ろから）
' UTIL_Array_Sort.bas
Option Explicit
Public Sub StableSort2D(ByRef a As Variant, ByVal keyCol As Long, ByVal asc As Boolean)
Dim n As Long: n = UBound(a, 1): If n <= 2 Then Exit Sub
Dim t As Variant: ReDim t(1 To n, 1 To UBound(a, 2))
Dim w As Long: w = 1
Do While w < n
Dim i As Long: i = 2
Do While i <= n
Dim L As Long: L = i
Dim M As Long: M = WorksheetFunction.Min(i + w - 1, n)
Dim R As Long: R = WorksheetFunction.Min(i + 2 * w - 1, n)
MergeBlocks a, t, L, M, R, keyCol, asc
i = i + 2 * w
Loop
Dim r As Long, c As Long
For r = 2 To n: For c = 1 To UBound(a, 2): a(r, c) = t(r, c): Next c: Next r
w = w * 2
Loop
End Sub
Private Sub MergeBlocks(ByRef a As Variant, ByRef t As Variant, ByVal L As Long, ByVal M As Long, ByVal R As Long, ByVal k As Long, ByVal asc As Boolean)
Dim i As Long: i = L, j As Long: j = M + 1, p As Long: p = L
Do While i <= M And j <= R
If Cmp(a(i, k), a(j, k), asc) <= 0 Then CopyRow a, i, t, p: i = i + 1 Else CopyRow a, j, t, p: j = j + 1
p = p + 1
Loop
Do While i <= M: CopyRow a, i, t, p: i = i + 1: p = p + 1: Loop
Do While j <= R: CopyRow a, j, t, p: j = j + 1: p = p + 1: Loop
End Sub
Private Sub CopyRow(ByRef src As Variant, ByVal r As Long, ByRef dst As Variant, ByVal k As Long)
Dim c As Long: For c = 1 To UBound(src, 2): dst(k, c) = src(r, c): Next
End Sub
Private Function Cmp(ByVal x As Variant, ByVal y As Variant, ByVal asc As Boolean) As Long
Dim sx As String: sx = LCase$(Trim$(CStr(x))), sy As String: sy = LCase$(Trim$(CStr(y)))
Dim r As Long: If sx < sy Then r = -1 ElseIf sx > sy Then r = 1 Else r = 0
Cmp = IIf(asc, r, -r)
End Function
Distinct（辞書で重複排除）
' UTIL_Array_Distinct.bas
Option Explicit
Private Const SEP As String = Chr$(30)
Public Function DistinctByKey(ByVal a As Variant, ByVal keyCols() As Long) As Variant
Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
Dim out() As Variant: ReDim out(1 To UBound(a, 1), 1 To UBound(a, 2))
Dim r As Long, w As Long: w = 1
For r = 1 To UBound(a, 1)
Dim k As String: k = BuildKey(a, r, keyCols)
If Not d.Exists(k) Then
d(k) = True: w = w + 1
Dim c As Long: For c = 1 To UBound(a, 2): out(w - 1, c) = a(r, c): Next
End If
Next
ReDim Preserve out(1 To w - 1, 1 To UBound(a, 2))
DistinctByKey = out
End Function
Private Function BuildKey(ByVal a As Variant, ByVal r As Long, ByVal idx() As Long) As String
Dim i As Long, s As String
For i = LBound(idx) To UBound(idx): s = s & LCase$(Trim$(CStr(a(r, idx(i))))) & SEP: Next
BuildKey = s
End Function
重要ポイントの深掘り
- 安定ソートで“同値の元順序”が崩れないことを保証。多列キーは「後ろのキーから安定ソート」で簡潔に。
- 重複排除は辞書で線形時間。区切り文字は“ありえない文字”を使い、衝突を避けます。
- 文字比較は必ず正規化（Trim/LCase）して揺らぎを消します。
実務系テンプレ：UUID、ZIP、ハッシュ、差分
UUID（GUID）生成
' UTIL_Uuid.bas
Option Explicit
Public Function NewUuid() As String
NewUuid = Replace(Replace(CreateObject("Scriptlet.TypeLib").GUID, "{", ""), "}", "")
End Function
ZIP圧縮・展開（Windows標準）
' UTIL_Zip.bas
Option Explicit
Public Sub ZipFolder(ByVal srcFolder As String, ByVal zipPath As String)
If Dir(zipPath, vbNormal) <> "" Then Kill zipPath
CreateEmptyZip zipPath
Dim sh As Object: Set sh = CreateObject("Shell.Application")
sh.NameSpace(zipPath).CopyHere sh.NameSpace(srcFolder).Items, 16
End Sub
Public Sub UnzipTo(ByVal zipPath As String, ByVal dstFolder As String)
If Dir(dstFolder, vbDirectory) = "" Then MkDir dstFolder
Dim sh As Object: Set sh = CreateObject("Shell.Application")
sh.NameSpace(dstFolder).CopyHere sh.NameSpace(zipPath).Items, 16
End Sub
Private Sub CreateEmptyZip(ByVal zipPath As String)
Dim h As Integer: h = FreeFile
Open zipPath For Binary As #h
Put #h, , Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String$(18, Chr$(0))
Close #h
End Sub
ハッシュ（SHA-256／軽量CRC）
' UTIL_Hash.bas
Option Explicit
Public Function FileSha256(ByVal path As String) As String
Dim sh As Object: Set sh = CreateObject("WScript.Shell")
Dim p As Object: Set p = sh.Exec("powershell -NoProfile -Command ""(Get-FileHash -Algorithm SHA256 -Path '" & Replace(path, "'", "''") & "').Hash""")
FileSha256 = Trim$(p.StdOut.ReadAll)
End Function
Public Function Crc32(ByVal s As String) As Long
Static table(255) As Long, inited As Boolean
Dim i As Long, j As Long, c As Long
If Not inited Then
For i = 0 To 255
c = i: For j = 1 To 8: c = IIf((c And 1) <> 0, &HEDB88320 Xor (c \ 2), (c \ 2)): Next
table(i) = c
Next: inited = True
End If
Dim bytes() As Byte: bytes = StrConv(s, vbFromUnicode)
Dim crc As Long: crc = &HFFFFFFFF
For i = LBound(bytes) To UBound(bytes): crc = table((crc Xor bytes(i)) And &HFF) Xor (crc \ 256): Next
Crc32 = Not crc
End Function
差分（表の追加・削除・変更）
' UTIL_Diff.bas
Option Explicit
Private Const SEP As String = Chr$(30)
Public Sub DiffTables(ByVal oldSheet As String, ByVal newSheet As String, _
ByVal keyCols As String, ByVal valCols As String)
Dim o As Variant: o = Worksheets(oldSheet).Range("A1").CurrentRegion.Value
Dim n As Variant: n = Worksheets(newSheet).Range("A1").CurrentRegion.Value
Dim keysO() As Long: keysO = ColsToIndex(keyCols)
Dim valsO() As Long: valsO = ColsToIndex(valCols)
Dim keysN() As Long: keysN = ColsToIndex(keyCols)
Dim valsN() As Long: valsN = ColsToIndex(valCols)
Dim dOld As Object: Set dOld = CreateObject("Scripting.Dictionary")
Dim dHashOld As Object: Set dHashOld = CreateObject("Scripting.Dictionary")
Dim r As Long
For r = 2 To UBound(o, 1)
Dim k As String: k = BuildKey(o, r, keysO)
dOld(k) = r: dHashOld(k) = BuildHash(o, r, valsO)
Next
Dim ws As Worksheet: Set ws = PrepareOut("TableDiff")
ws.Range("A1:D1").Value = Array("Type", "Key", "OldHash", "NewHash")
Dim rowOut As Long: rowOut = 2
Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary")
For r = 2 To UBound(n, 1)
Dim k As String: k = BuildKey(n, r, keysN)
Dim hn As String: hn = BuildHash(n, r, valsN)
seen(k) = True
If Not dOld.Exists(k) Then
ws.Cells(rowOut, 1).Value = "ADDED": ws.Cells(rowOut, 2).Value = k: ws.Cells(rowOut, 4).Value = hn: rowOut = rowOut + 1
ElseIf dHashOld(k) <> hn Then
ws.Cells(rowOut, 1).Value = "CHANGED": ws.Cells(rowOut, 2).Value = k
ws.Cells(rowOut, 3).Value = dHashOld(k): ws.Cells(rowOut, 4).Value = hn: rowOut = rowOut + 1
End If
Next
Dim k
For Each k In dOld.Keys
If Not seen.Exists(k) Then
ws.Cells(rowOut, 1).Value = "DELETED": ws.Cells(rowOut, 2).Value = k: ws.Cells(rowOut, 3).Value = dHashOld(k): rowOut = rowOut + 1
End If
Next
ws.Columns.AutoFit
End Sub
Private Function ColsToIndex(ByVal csv As String) As Long()
Dim p() As String: p = Split(csv, ",")
Dim idx() As Long: ReDim idx(0 To UBound(p))
Dim i As Long: For i = 0 To UBound(p): idx(i) = Range(Trim$(p(i)) & "1").Column: Next
ColsToIndex = idx
End Function
Private Function BuildKey(ByVal a As Variant, ByVal r As Long, ByVal idx() As Long) As String
Dim i As Long, s As String
For i = LBound(idx) To UBound(idx): s = s & LCase$(Trim$(CStr(a(r, idx(i))))) & SEP: Next
BuildKey = s
End Function
Private Function BuildHash(ByVal a As Variant, ByVal r As Long, ByVal idx() As Long) As String
Dim i As Long, s As String
For i = LBound(idx) To UBound(idx): s = s & Trim$(CStr(a(r, idx(i)))) & "|": Next
BuildHash = s ' 実務はSHA-256推奨
End Function
Private Function PrepareOut(ByVal name As String) As Worksheet
Dim ws As Worksheet
On Error Resume Next: Set ws = Worksheets(name): On Error GoTo 0
If ws Is Nothing Then Set ws = Worksheets.Add: ws.Name = name
ws.Cells.Clear: Set PrepareOut = ws
End Function
重要ポイントの深掘り
- UUIDは書式を最初に決める（ハイフンあり・なし）。突合ミスを防げます。
- ZIPは標準で最短、暗号や大容量なら外部ツール併用（7-Zip）へ拡張可能。
- 差分は「キー一致→値ハッシュ比較」が定番。仕様に合わせて正規化ルールを固定します。
スケジューラとテスト：完全自動のための枠
OnTimeスケジューラ（短いチャンクで回す）
' ModScheduler.bas
Option Explicit
Private gNext As Date, gStop As Boolean
Public Sub StartScheduler()
gStop = False
Application.OnTime Now, "'" & ThisWorkbook.Name & "'!Tick", , True
End Sub
Public Sub StopScheduler()
gStop = True
End Sub
Public Sub Tick()
On Error GoTo EH
If gStop Then Exit Sub
AppEnter "Tick"
' TODO: 処理チャンク（監視→取り込み→検証→出力）
AppLeave
gNext = Now + (0.2 / 86400#) ' 200ms間隔
Application.OnTime gNext, "'" & ThisWorkbook.Name & "'!Tick", , True
Exit Sub
EH:
Log "ERROR", "Tick", Err.Description
AppLeave
End Sub
テスト基盤（アサーション＋ランナー）
' ModTest.bas
Option Explicit
Public Passed As Long, Failed As Long
Public Sub AssertEquals(ByVal exp As Variant, ByVal act As Variant, ByVal msg As String)
If CStr(exp) = CStr(act) Then Passed = Passed + 1 Else Failed = Failed + 1: Debug.Print "FAIL: "; msg
End Sub
Public Sub RunAllTests()
Passed = 0: Failed = 0
Test_SortDistinct
MsgBox "Tests: Passed=" & Passed & " Failed=" & Failed
End Sub
Public Sub Test_SortDistinct()
Dim a As Variant: ReDim a(1 To 6, 1 To 2)
a(1, 1) = "Key": a(1, 2) = "Val"
a(2, 1) = "b": a(2, 2) = 1
a(3, 1) = "a": a(3, 2) = 2
a(4, 1) = "a": a(4, 2) = 3
a(5, 1) = "c": a(5, 2) = 4
a(6, 1) = "b": a(6, 2) = 5
StableSort2D a, 1, True
a = DistinctByKey(a, Array(1))
AssertEquals 4, UBound(a, 1), "b,a,a,c,b → ヘッダ＋a/b/cで4行"
End Sub
重要ポイントの深掘り
- OnTimeで“短いチャンクを回す”設計は、UIが固まらず失敗時も再開しやすい。
- テストは配列I/Oで速く回し、合格基準（Failed=0）を明示。ブック起動時に毎回走らせると“壊れたまま配布”が防げます。
例題：10万行の顧客明細を検証→重複排除→並べ替え→レポート
エントリーポイント（ボタン1つ）
' ModEntry.bas
Option Explicit
Public Sub RunPipeline()
On Error GoTo EH
AppEnter "Run"
LoadConfig
Dim wsIn As Worksheet: Set wsIn = Worksheets("Input")
Dim a As Variant: a = ReadRegion(wsIn)
' 必須・型チェック（例）
Dim r As Long, errs As Long
For r = 2 To UBound(a, 1)
If Len(Trim$(CStr(a(r, 1)))) = 0 Then errs = errs + 1 ' 顧客ID必須
If Not IsNumeric(a(r, 3)) Then errs = errs + 1 ' 金額型
Next
If errs > 0 Then Log "WARN", "Validate", "errs=" & errs
' ソート→重複排除
StableSort2D a, 1, True
a = DistinctByKey(a, Array(1)) ' 顧客IDで重複排除
Dim wsOut As Worksheet: Set wsOut = Worksheets("Report")
WriteRegion wsOut, a
Log "INFO", "Export", "rows=" & UBound(a, 1)
AppLeave
MsgBox "完了: " & UBound(a, 1) & " 行", vbInformation
Exit Sub
EH:
Log "ERROR", "RunPipeline", Err.Description
AppLeave
MsgBox "失敗: " & Err.Description, vbExclamation
End Sub
重要ポイントの深掘り
- 検証→ソート→重複排除→出力を“配列中心”で完結。10万行規模でも数秒〜十数秒に収まります。
- ログで「検証エラー数・出力行数」を記録し、運用の見える化を標準化します。
落とし穴と対策（深掘り）
セルを逐次操作して遅い
Range⇔配列の一括I/Oへ。処理はすべてメモリで完結させる。
同値の順序が崩れる
安定ソートを標準に。多列キーは後ろから順に安定ソート。
キーの揺らぎで重複排除に失敗
Trim/LCaseで正規化。必要なら全半角統一を事前処理へ。
設定がコード直書きで運用が硬い
config.iniへ外出し。既定値はコード側に持たせて“欠けても動く”。
参照設定の違いで配布事故
CreateObjectでLate Binding。外部ツールパスは設定化。
まとめ：モジュール化＋配列中心＋外部設定＋テストの“型”が、大規模を支える
- 基盤（App/Config/Log）で壊れない土台を作り、I/Oは配列、比較は正規化、重複は辞書、並べ替えは安定ソートで統一。
- UUID、ZIP、ハッシュ、差分、スケジューラ、テストまで揃え、現場要件に合わせて差し替え・拡張可能。
- 「入口はボタン1つ・毎回ログ・毎回テスト」で、拡張しても壊れない運用へ。