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

This commit is contained in:
guanxiangwei
2026-05-27 17:22:12 +09:00
parent 1a0010b464
commit df9cd0a7ad
9 changed files with 367 additions and 12 deletions

65
AGENTS.md Normal file
View File

@@ -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

View File

@@ -0,0 +1,4 @@
"000001","後楽園","後楽園","東京都駅","",""
"000002","银座","银座","東京都駅","",""
"000003","脇町IC","脇町IC","徳島自動車道","",""
"000004","徳島IC","徳島IC","徳島自動車道","",""
1 000001 後楽園 後楽園 東京都駅
2 000002 银座 银座 東京都駅
3 000003 脇町IC 脇町IC 徳島自動車道
4 000004 徳島IC 徳島IC 徳島自動車道

View File

@@ -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 过程的注释头
- [ ] 考虑分离配置管理到独立模块

View File

@@ -150,6 +150,9 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet)
For j = 0 To expectedColumnCount - 1 For j = 0 To expectedColumnCount - 1
ws.Cells(writeRow, ws.Range(colLetters(j) & "1").Column).Value = CleanCSVField(CStr(csvData(i, j + 1))) ws.Cells(writeRow, ws.Range(colLetters(j) & "1").Column).Value = CleanCSVField(CStr(csvData(i, j + 1)))
Next j Next j
If cfg.Exists("DisplayCol") Then
Call BuildDisplayDropdown(ws, writeRow)
End If
writeRow = writeRow + 1 writeRow = writeRow + 1
Next i Next i

View File

@@ -221,14 +221,29 @@ InvalidColumn:
End Function End Function
'Clear single row data and format '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) Sub ClearDataRow(ByVal ws As Worksheet, ByVal rowNum As Long)
If rowRow >= 7 Then Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowRow, startCol), ws.Cells(rowRow, endCol)) If Not sheetConfDict.Exists(ws.CodeName) Then
Err.Raise ERR_CONFIG_NOT_FOUND, "ClearDataRow", "Sheet not configured: " & ws.CodeName
End If
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.ClearContents
clearRange.Interior.Color = vbWhite clearRange.Interior.Color = vbWhite
ws.Range(ws.Cells(rowRow, errorCol), ws.Cells(rowRow, errorCol)).ClearContents clearRange.Validation.Delete
End If
End Function 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 'Clear all data rows from startRow to lastDataRow
Sub ClearDataRows(ByVal ws As Worksheet) Sub ClearDataRows(ByVal ws As Worksheet)

View File

@@ -399,6 +399,7 @@ Private Sub RefreshSheetDict()
sheetConf("StartCol") = "C" sheetConf("StartCol") = "C"
sheetConf("EndCol") = "H" sheetConf("EndCol") = "H"
sheetConf("ErrorCol") = "B" sheetConf("ErrorCol") = "B"
sheetConf("DisplayCol") = "H"
sheetConf("StartRow") = 7 sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5 sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8" sheetConf("CSV_Encoding") = "utf-8"
@@ -589,15 +590,27 @@ Private Sub RefreshSheetDict()
End Sub End Sub
Public Function GetSheetConfig() As Object 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 Set GetSheetConfig = sheetConfDict
End Function 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() Public Sub RefreshMasterCache()
' Fixed cache names ' Fixed cache names
Dim fixedCaches As Variant Dim fixedCaches As Variant
fixedCaches = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3, _ 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")
' Refresh fixed caches ' Refresh fixed caches
Dim cacheName As Variant Dim cacheName As Variant
@@ -605,6 +618,8 @@ Public Sub RefreshMasterCache()
Call RefreshCache(CStr(cacheName)) Call RefreshCache(CStr(cacheName))
Call WriteCachesSheet(CStr(cacheName)) Call WriteCachesSheet(CStr(cacheName))
Next cacheName Next cacheName
Call RefreshEnumCache
End Sub End Sub
Public Sub RefreshKukanCache(ByVal sheetName As String) Public Sub RefreshKukanCache(ByVal sheetName As String)

View File

@@ -218,6 +218,32 @@ Public Sub BuildRenrakuDropdown(ws As Worksheet, ByVal columnLetter As String, B
End With End With
End Sub 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 ' Build dropdown using Caches sheet
Public Sub BuildDropdownFromCacheNamedRange(ws As Worksheet, columnLetter As String, rowNum As Long, cacheName As String) Public Sub BuildDropdownFromCacheNamedRange(ws As Worksheet, columnLetter As String, rowNum As Long, cacheName As String)
Dim formula As String: formula = GetValidationFormula(cacheName) Dim formula As String: formula = GetValidationFormula(cacheName)

View File

@@ -13,6 +13,39 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target) Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub 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 End Sub
' Prevent insert/delete row in header area ' 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) checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub 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 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 If checkResult = False Then Exit Sub
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol) checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)