通勤認定エクセルツール対応12 表示しない対応

2026-05-27 17:22:12 +09:00
parent 1a0010b464
commit df9cd0a7ad
9 changed files with 367 additions and 12 deletions
--- a/AGENTS.md
+++ b/AGENTS.md
@@ -0,0 +1,65 @@
+# AGENTS.md - VBA Coding Constraints
+
+## Project Overview
+- **Project Name**: Commuter Allowance Editor
+- **App**: Excel 2021
+- **Purpose**: Edit commuter certification by referencing master data
+
+## VBA Coding Constraints
+### Naming Conventions
+- **Module**: `mod[Domain][Action]` (e.g., `modReportGenerator`, `modDataValidation`)
+- **Class Module**: `cls[Noun]` (e.g., `clsInvoiceParser`, `clsDbConnection`)
+- **Public Procedure**: PascalCase (e.g., `GenerateMonthlyReport`)
+- **Private Procedure**: camelCase with prefix (e.g., `parseRawData`, `validateInput`)
+- **Constant**: `UPPER_SNAKE_CASE` with scope prefix (e.g., `PUB_MAX_RETRY_COUNT`, `PRV_DEFAULT_PATH`)
+- **Variable**: Hungarian or semantic naming, but **must be consistent across the project**
+
+### Mandatory Rules
+- ✅ Every module must start with `Option Explicit`
+- ✅ All Public procedures must have a comment header (description, params, return value, author, date)
+- ✅ `On Error Resume Next` is forbidden as global error handling. Only allowed in small scopes paired with `On Error GoTo 0`
+- ✅ Object variables must be explicitly `Set obj = Nothing` in `Finally` block or at end of procedure
+- ✅ Long operations must disable `ScreenUpdating`, `Calculation`, `EnableEvents` and restore on exit
+- ❌ Forbidden: `Select` / `Selection` / `ActiveCell`. Always reference Range/Worksheet objects directly
+- ❌ Forbidden: hardcoded file paths or connection strings. Use config sheet or constants module
+
+## Project Structure
+
+vba/
+  AGENTS.md, README.md, .gitignore, LICENSE
+  通勤手当テンプレート2026xxxx.xlsm  (latest date version)
+  data/                     CSV master data (14 files)
+  documents/                design docs (3 files)
+  sql/                      DB definitions (4 files)
+  src/sh/
+    juk/                    address module
+      init_module/Import_modules.bas
+      module/Common_Button.bas
+    tuk/                    commuter module
+      init_module/
+        Import_modules.bas
+        Test_Cache.bas
+      module/
+        Common_Button.bas (306 lines)
+        Common_Constants.bas
+        Common_File_Utils.bas (347 lines)
+        Common_Functions.bas (486 lines)
+        Common_Global_Cache.bas (586 lines)
+        Common_Selector.bas (161 lines)
+        Common_Shape.bas
+      sheet/                 sheet classes (13 files)
+        C1.cls (846 lines) - commuter allowance editor
+        M1.cls (167 lines) - section master
+        M2.cls (400 lines) - section detail master
+        O1.cls (5 lines) - address master
+        O2.cls (6 lines) - sender master (507)
+        O3.cls (61 lines) - master 225
+        T1.cls (54 lines) - commutation pass master
+        T2.cls (114 lines) - ticket master
+        T3.cls (74 lines) - master 246
+        Z1.cls (64 lines) - transport master (222)
+        Z2.cls (54 lines) - decision master (223)
+        Z3.cls (57 lines) - monthly amount decision master (224)
+        Z4.cls - master Z4
+
+Sheet class prefixes: C=commuter editing, M=section master, O=other, T=commuter route, Z=master config
--- a/data/221利用区間発着名区分.csv
+++ b/data/221利用区間発着名区分.csv
@@ -0,0 +1,4 @@
+"000001","後楽園","後楽園","東京都駅","",""
+"000002","银座","银座","東京都駅","",""
+"000003","脇町ＩＣ","脇町ＩＣ","徳島自動車道","",""
+"000004","徳島ＩＣ","徳島ＩＣ","徳島自動車道","",""
--- a/documents/checklist-2026-05-27.md
+++ b/documents/checklist-2026-05-27.md
@@ -0,0 +1,194 @@
+# VBA 工程规范检查报告
+
+**检查日期**: 2026-05-27  
+**项目**: Commuter Allowance Editor (通勤手当テンプレート)  
+**VBA 标准**: AGENTS.md 规范
+
+---
+
+## 1. 模块/文件结构检查
+
+| 文件 | 路径 | 状态 | 说明 |
+|------|------|------|------|
+| Common_Button.bas | tuk/module/ | ✅ | 有 `Option Explicit`，注释头规范 |
+| Common_Constants.bas | tuk/module/ | ✅ | 命名正确，常量定义规范 |
+| Common_Functions.bas | tuk/module/ | ⚠️ | Module Desc 写的是 `Module_Common`，应为 `Common_Functions` |
+| Common_Global_Cache.bas | tuk/module/ | ✅ | 缓存架构清晰 |
+| Common_File_Utils.bas | tuk/module/ | ✅ | CSV 处理良好 |
+| Common_Selector.bas | tuk/module/ | ✅ | 下拉列表构建器 |
+| Common_Shape.bas | tuk/module/ | ❌ | 硬编码了工作表名 `"M1"` 和形状名 |
+| Import_modules.bas | tuk/init_module/ | ❌ | 硬编码路径 `D:\Project\upds7\vba\` |
+| Test_Cache.bas | tuk/init_module/ | ❌ | 模块名不符合规范（应为 `modTestCache`） |
+| Common_Button.bas | juk/module/ | ⚠️ | 只有 10 行，过于简单，缺乏通用性 |
+| SQL_Generate.bas | juk/module/ | ⚠️ | Module Desc 缺失 |
+| Import_modules.bas | juk/init_module/ | ❌ | 硬编码路径 `D:\Project\upds7\vba\src\sh\juk\module` |
+
+---
+
+## 2. Sheet 类 (cls 文件) 检查
+
+| Sheet | 文件 | 行数 | 状态 | 问题 |
+|-------|------|------|------|------|
+| C1 | tuk/sheet/C1.cls | 846 | ✅ | 结构良好，事件处理完善 |
+| M1 | tuk/sheet/M1.cls | 167 | ✅ | 有 `Worksheet_Change` 和 `Worksheet_BeforeRightClick` |
+| M2 | tuk/sheet/M2.cls | 400 | ✅ | Validation 逻辑完整 |
+| T1 | tuk/sheet/T1.cls | 54 | ⚠️ | `Worksheet_Change` 是空的，只有 `Validate` |
+| T2 | tuk/sheet/T2.cls | 114 | ⚠️ | 同上 |
+| T3 | tuk/sheet/T3.cls | 74 | ⚠️ | 同上 |
+| O1 | tuk/sheet/O1.cls | 5 | ❌ | `Validate` 是空壳（只有 `Exit Sub`） |
+| O2 | tuk/sheet/O2.cls | 6 | ❌ | 同上 |
+| O3 | tuk/sheet/O3.cls | 61 | ❌ | 同上 |
+| Z1 | tuk/sheet/Z1.cls | 64 | ✅ | 基本完整 |
+| Z2 | tuk/sheet/Z2.cls | 54 | ✅ | 基本完整 |
+| Z3 | tuk/sheet/Z3.cls | 57 | ✅ | 基本完整 |
+| Z4 | tuk/sheet/Z4.cls | - | ✅ | 基本完整 |
+
+---
+
+## 3. 严重问题 (高优先级)
+
+### 3.1 硬编码路径 (违反 AGENTS.md 禁止硬编码规则)
+
+| 文件 | 行号 | 问题代码 |
+|------|------|---------|
+| Common_Shape.bas | 47 | `sheetName:="M1"` |
+| Import_modules.bas (tuk) | 8 | `"D:\Project\upds7\vba\"` |
+| Import_modules.bas (tuk) | 9 | `"D:\Project\upds7\vba\src\sh\tuk\module"` |
+| ImportJukModules | 7 | `"D:\Project\upds7\vba\src\sh\juk\module"` |
+
+**修改要求**: 路径应从配置文件或常量模块读取，禁止硬编码。
+
+### 3.2 变量未声明
+
+多个 sheet 的 `Validate` 方法中使用 `checkResult`，但 **未声明**：
+
+```vba
+' 出现在 T1.cls, T2.cls, T3.cls, Z1.cls, Z2.cls, Z3.cls 中:
+checkResult = CheckRequired(...)  ' 缺少: Dim checkResult As Boolean
+```
+
+**涉及文件**:
+- tuk/sheet/T1.cls
+- tuk/sheet/T2.cls
+- tuk/sheet/T3.cls
+- tuk/sheet/Z1.cls
+- tuk/sheet/Z2.cls
+- tuk/sheet/Z3.cls
+
+### 3.3 空 Validate 方法
+
+`O1.cls`, `O2.cls`, `O3.cls` 的 `Validate` 是空壳：
+
+```vba
+Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
+    On Error GoTo ErrHandler
+    Exit Sub  ' 实际未做任何验证
+ErrHandler:
+    lastErrorMsg = Err.Description
+End Sub
+```
+
+**修改要求**: 实现完整的验证逻辑或删除空方法。
+
+---
+
+## 4. 中优先级问题
+
+### 4.1 命名不一致
+
+| 当前名称 | AGENTS.md 规范 | 应改为 |
+|---------|---------------|--------|
+| `Test_Cache` | `cls[Noun]` 或 `mod[Noun]` | `clsTestCache` 或 `modTestCache` |
+| `Common_Shape` | `mod[Domain][Action]` | `modShapeUtils` |
+
+### 4.2 未使用的参数
+
+```vba
+' T1.cls, T2.cls, T3.cls:
+Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
+    ' lastDataRow 参数从未使用
+```
+
+### 4.3 错误处理简陋
+
+`HandleError` 只显示消息，不记录到日志或提供堆栈跟踪：
+
+```vba
+Public Sub HandleError(Optional ByVal sourceProcedure As String = "")
+    Dim shortCode As String: shortCode = Right("0000" & CStr(Err.Number - vbObjectError), 4)
+    MsgBox "[ERROR] " & shortCode & " : " & Err.Description, vbExclamation
+    ' 没有写入日志文件，没有堆栈跟踪
+End Sub
+```
+
+### 4.4 Module Desc 与实际不符
+
+```vba
+' Common_Functions.bas 第 4 行:
+' Module Desc: Module_Common  (应为 Common_Functions)
+```
+
+---
+
+## 5. 低优先级问题
+
+### 5.1 Public 过程缺少注释头
+
+虽然 Module 级别有注释头，但内部 Public Function/Sub 缺少参数/返回值说明：
+
+```vba
+' 当前:
+Function GetCode(ByVal text As String) As String
+
+' 应为:
+' ============================================================
+' Function Name: GetCode
+' Description: Get left part of MakeSelect format (e.g., "1:JR" -> "1")
+' Params: text - Input string in code:value format
+' Returns: String - Left part before colon, or full text if no colon
+' ============================================================
+Function GetCode(ByVal text As String) As String
+```
+
+### 5.2 魔法数字/列号缺乏注释
+
+`C1.cls` 中大量使用魔法数字，虽然有常量定义，但注释可更清晰：
+
+```vba
+' 当前:
+KUKAN_CODE_COLS = Array(19, 27, 35, 43)  ' S, AA, AI, AQ
+
+' 建议:
+' S列(19), AA열(27), AI열(35), AQ열(43) - 区分コード
+KUKAN_CODE_COLS = Array(19, 27, 35, 43)
+```
+
+### 5.3 缺少配置管理模块
+
+所有配置硬编码在 `Common_Global_Cache.bas` 的 `RefreshSheetDict()` 中，建议分离为独立的 `modConfig.bas`。
+
+---
+
+## 6. 修改优先级汇总
+
+| 优先级 | 问题 | 影响 | 涉及文件数 |
+|-------|------|------|-----------|
+| **高** | 未声明变量 `checkResult` | 运行时错误 | 6 |
+| **高** | 硬编码路径 | 不可移植 | 3 |
+| **高** | O1/O2/O3 空 Validate | 功能不完整 | 3 |
+| **中** | 变量命名不一致 | 代码可读性 | 2 |
+| **中** | 错误处理简陋 | 调试困难 | 全部 |
+| **中** | 未使用参数 `lastDataRow` | 代码冗余 | 3 |
+| **低** | 注释细节缺失 | 维护难度 | 多个 |
+
+---
+
+## 7. 后续行动
+
+- [ ] 修复未声明变量问题
+- [ ] 移除硬编码路径，改用配置模块
+- [ ] 实现 O1/O2/O3 的 Validate 方法或删除空壳
+- [ ] 统一模块命名规范
+- [ ] 增强错误处理（添加日志记录）
+- [ ] 补充 Public 过程的注释头
+- [ ] 考虑分离配置管理到独立模块
--- a/src/sh/tuk/module/Common_Button.bas
+++ b/src/sh/tuk/module/Common_Button.bas
@@ -150,6 +150,9 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet)
        For j = 0 To expectedColumnCount - 1
            ws.Cells(writeRow, ws.Range(colLetters(j) & "1").Column).Value = CleanCSVField(CStr(csvData(i, j + 1)))
        Next j
+        If cfg.Exists("DisplayCol") Then
+            Call BuildDisplayDropdown(ws, writeRow)
+        End If
        writeRow = writeRow + 1
    Next i

--- a/src/sh/tuk/module/Common_Functions.bas
+++ b/src/sh/tuk/module/Common_Functions.bas
@@ -221,14 +221,29 @@ InvalidColumn:
 End Function

 'Clear single row data and format
-Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, ByVal rowRow As Long, Optional ByVal errorCol As Long = 2)
-    If rowRow >= 7 Then
-        Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowRow, startCol), ws.Cells(rowRow, endCol))
-        clearRange.ClearContents
-        clearRange.Interior.Color = vbWhite
-        ws.Range(ws.Cells(rowRow, errorCol), ws.Cells(rowRow, errorCol)).ClearContents
+Sub ClearDataRow(ByVal ws As Worksheet, ByVal rowNum As Long)
+    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
+    If Not sheetConfDict.Exists(ws.CodeName) Then
+        Err.Raise ERR_CONFIG_NOT_FOUND, "ClearDataRow", "Sheet not configured: " & ws.CodeName
    End If
-End Function
+
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
+    
+    Dim startRow As Long: startRow = sheetConf("StartRow")
+    Dim startCol As String: startCol = sheetConf("StartCol")
+    Dim endCol As String: endCol = sheetConf("EndCol")
+    Dim errorCol As String: errorCol = sheetConf("ErrorCol")
+
+    Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
+    clearRange.ClearContents
+    clearRange.Interior.Color = vbWhite
+    clearRange.Validation.Delete
+
+    Dim errorRange As Range: Set errorRange = ws.Range(ws.Cells(rowNum, errorCol), ws.Cells(rowNum, errorCol))
+    errorRange.ClearContents
+    errorRange.Interior.Color = vbWhite
+    errorRange.Validation.Delete
+End Sub

 'Clear all data rows from startRow to lastDataRow
 Sub ClearDataRows(ByVal ws As Worksheet)
--- a/src/sh/tuk/module/Common_Global_Cache.bas
+++ b/src/sh/tuk/module/Common_Global_Cache.bas
@@ -399,6 +399,7 @@ Private Sub RefreshSheetDict()
    sheetConf("StartCol") = "C"
    sheetConf("EndCol") = "H"
    sheetConf("ErrorCol") = "B"
+    sheetConf("DisplayCol") = "H"
    sheetConf("StartRow") = 7
    sheetConf("HeaderRow") = 5
    sheetConf("CSV_Encoding") = "utf-8"
@@ -589,15 +590,27 @@ Private Sub RefreshSheetDict()
 End Sub

 Public Function GetSheetConfig() As Object
-    If sheetConfDict Is Nothing Then Call RefreshSheetDict
+    If sheetConfDict Is Nothing Then 
+        Call RefreshSheetDict
+        Call RefreshEnumCache
+    End If
    Set GetSheetConfig = sheetConfDict
 End Function

+Public Sub RefreshEnumCache()
+    Dim fixedEnumCaches As Variant
+    fixedEnumCaches = Array("tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
+    
+    Dim cacheName As Variant
+    For Each cacheName In fixedEnumCaches
+        Call RefreshCache(CStr(cacheName))
+    Next cacheName
+End Sub
+
 Public Sub RefreshMasterCache()
    ' Fixed cache names
    Dim fixedCaches As Variant
-    fixedCaches = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3, _
-        "tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
+    fixedCaches = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3)
    
    ' Refresh fixed caches
    Dim cacheName As Variant
@@ -605,6 +618,8 @@ Public Sub RefreshMasterCache()
        Call RefreshCache(CStr(cacheName))
        Call WriteCachesSheet(CStr(cacheName))
    Next cacheName
+
+    Call RefreshEnumCache
 End Sub

 Public Sub RefreshKukanCache(ByVal sheetName As String)
--- a/src/sh/tuk/module/Common_Selector.bas
+++ b/src/sh/tuk/module/Common_Selector.bas
@@ -218,6 +218,32 @@ Public Sub BuildRenrakuDropdown(ws As Worksheet, ByVal columnLetter As String, B
    End With
 End Sub

+' Create display dropdown
+Public Sub BuildDisplayDropdown(ws As Worksheet, ByVal rowNum As Long)
+    ' validate sheet
+    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
+    If Not sheetConfDict.Exists(ws.CodeName) Then
+        Err.Raise ERR_CONFIG_NOT_FOUND, "BuildDisplayDropdown", "Sheet not configured: " & ws.CodeName
+    End If
+
+    ' validate Display
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
+    If Not sheetConf.Exists("DisplayCol") Then
+        Err.Raise ERR_CONFIG_NOT_FOUND, "BuildDisplayDropdown", "Display Column not configured: " & ws.CodeName
+    End If
+
+    Dim displayCol As String: displayCol = sheetConf("DisplayCol")
+    Dim dropdownList As String: dropdownList = "0:OFF,1:ON"
+    With ws.Range(displayCol & rowNum).Validation
+        .Delete
+        .Add Type:=xlValidateList, Formula1:=dropdownList
+        .IgnoreBlank = True
+        .InCellDropdown = True
+        .InputTitle = ""
+        .InputMessage = ""
+    End With
+End Sub
+
 ' Build dropdown using Caches sheet
 Public Sub BuildDropdownFromCacheNamedRange(ws As Worksheet, columnLetter As String, rowNum As Long, cacheName As String)
    Dim formula As String: formula = GetValidationFormula(cacheName)
--- a/src/sh/tuk/sheet/Z4.cls
+++ b/src/sh/tuk/sheet/Z4.cls
@@ -13,6 +13,39 @@ Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
    If HasHeaderEdit = True Then Exit Sub

+    ' Check if cache is loaded
+    Application.EnableEvents = False
+    On Error GoTo Finally
+
+    ' === Column C changes: Create L column dropdown ===
+    If Target.Column = 3 And Target.Row >= 7 Then
+        Dim cell As Range
+        For Each cell In Target
+            If Trim(cell.Value) = "" Then
+                Call ClearDataRow(Me, cell.Row)
+            Else
+                Call BuildDisplayDropdown(Me, cell.Row)
+            End If
+        Next
+    End If
+
+    ' === Column D changes: Fill E column ===
+    If Target.Column = 8 And Target.Row >= 7 Then
+        Dim cellH As Range
+        For Each cellH In Target
+            Dim displayValue As String: displayValue = Trim(cellH.Value)
+            If displayValue <> "" Then
+                cellH.Value = GetCode(displayValue)
+            End If
+        Next
+    End If
+
+    Application.EnableEvents = True
+    Exit Sub
+
+Finally:
+    HandleError "Worksheet_Change"
+    Application.EnableEvents = True
 End Sub

 ' Prevent insert/delete row in header area
@@ -46,10 +79,10 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    checkResult = CheckRequired(ws, rowNum, 3, errorCol)
    If checkResult = False Then Exit Sub

-    checkResult = CheckChar(ws, rowNum, 3, 2, errorCol)
+    checkResult = CheckChar(ws, rowNum, 3, 6, errorCol)
    If checkResult = False Then Exit Sub

-    checkResult = CheckAlphanumeric(ws, rowNum, 3, 2, errorCol)
+    checkResult = CheckAlphanumeric(ws, rowNum, 3, 6, errorCol)
    If checkResult = False Then Exit Sub

    checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
--- a/通勤手当テンプレート20260525.xlsm
+++ b/通勤手当テンプレート20260525.xlsm