diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 0000000..5ff9cdc --- /dev/null +++ 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 \ No newline at end of file diff --git a/data/221利用区間発着名区分.csv b/data/221利用区間発着名区分.csv new file mode 100644 index 0000000..4d531f3 --- /dev/null +++ b/data/221利用区間発着名区分.csv @@ -0,0 +1,4 @@ +"000001","後楽園","後楽園","東京都駅","","" +"000002","银座","银座","東京都駅","","" +"000003","脇町IC","脇町IC","徳島自動車道","","" +"000004","徳島IC","徳島IC","徳島自動車道","","" diff --git a/documents/checklist-2026-05-27.md b/documents/checklist-2026-05-27.md new file mode 100644 index 0000000..8cc0065 --- /dev/null +++ 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 过程的注释头 +- [ ] 考虑分离配置管理到独立模块 \ No newline at end of file diff --git a/src/sh/tuk/module/Common_Button.bas b/src/sh/tuk/module/Common_Button.bas index aa94e96..6b90e03 100644 --- 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 diff --git a/src/sh/tuk/module/Common_Functions.bas b/src/sh/tuk/module/Common_Functions.bas index 9a94659..61b7b60 100644 --- 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) diff --git a/src/sh/tuk/module/Common_Global_Cache.bas b/src/sh/tuk/module/Common_Global_Cache.bas index c5c3478..3b26cbf 100644 --- 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) diff --git a/src/sh/tuk/module/Common_Selector.bas b/src/sh/tuk/module/Common_Selector.bas index bad050c..4b4fc6b 100644 --- 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) diff --git a/src/sh/tuk/sheet/Z4.cls b/src/sh/tuk/sheet/Z4.cls index 388e928..5abd803 100644 --- 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) diff --git a/通勤手当テンプレート20260525.xlsm b/通勤手当テンプレート20260525.xlsm index 43d5752..b60fb81 100644 Binary files a/通勤手当テンプレート20260525.xlsm and b/通勤手当テンプレート20260525.xlsm differ