updsv7/vba
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compare commits

base: updsv7:85707853e6a719cb77dd3eefa0568d97657e5549
Branches Tags
updsv7:main
...
compare: updsv7:8611cb4f1e880806c5f4fccc793bc98fb6418542
Branches Tags
updsv7:main

7 Commits
85707853e6 ... 8611cb4f1e

Author SHA1 Message Date
guanxiangwei
8611cb4f1e 通勤認定エクセルツール対応15 2026-05-30 16:48:10 +09:00
guanxiangwei
f84e4b4d3b 通勤認定エクセルツール対応14 2026-05-30 16:47:51 +09:00
guanxiangwei
29c9200132 通勤認定エクセルツール対応13 M1 対応2 2026-05-28 20:57:47 +09:00
guanxiangwei
50ef0c74cc 通勤認定エクセルツール対応12 M1 対応 2026-05-28 12:58:08 +09:00
guanxiangwei
df9cd0a7ad 通勤認定エクセルツール対応12 表示しない対応 2026-05-27 17:22:12 +09:00
guanxiangwei
1a0010b464 通勤認定エクセルツール対応12 Z4マスタ追加 2026-05-27 11:23:26 +09:00
guanxiangwei
ca2ae646fb 通勤認定エクセルツール対応12 Z4からO3に変更 2026-05-27 10:50:49 +09:00
44 changed files with 2522 additions and 1462 deletions
Expand all files Collapse all files

34
.VSCodeCounter/2026-04-23_10-41-31/details.md
View File

@@ -1,34 +0,0 @@
# Details
Date : 2026-04-23 10:41:31
Directory d:\\Project\\upds7\\vba\\src
Total : 19 files, 3122 codes, 483 comments, 650 blanks, all 4255 lines
[Summary](results.md) / Details / [Diff Summary](diff.md) / [Diff Details](diff-details.md)
## Files
| filename | language | code | comment | blank | total |
| :--- | :--- | ---: | ---: | ---: | ---: |
| [src/init\_module/Import\_modules.bas](/src/init_module/Import_modules.bas) | Visual Basic for Applications | 156 | 13 | 30 | 199 |
| [src/init\_module/Test\_Cache.bas](/src/init_module/Test_Cache.bas) | Visual Basic for Applications | 161 | 12 | 26 | 199 |
| [src/module/Common\_Button.bas](/src/module/Common_Button.bas) | Visual Basic for Applications | 257 | 29 | 73 | 359 |
| [src/module/Common\_File\_Utils.bas](/src/module/Common_File_Utils.bas) | Visual Basic for Applications | 262 | 43 | 43 | 348 |
| [src/module/Common\_Functions.bas](/src/module/Common_Functions.bas) | Visual Basic for Applications | 371 | 42 | 74 | 487 |
| [src/module/Common\_Global\_Cache.bas](/src/module/Common_Global_Cache.bas) | Visual Basic for Applications | 456 | 51 | 80 | 587 |
| [src/module/Common\_Selector.bas](/src/module/Common_Selector.bas) | Visual Basic for Applications | 122 | 22 | 18 | 162 |
| [src/sheet/C1.cls](/src/sheet/C1.cls) | Visual Basic for Applications | 664 | 83 | 100 | 847 |
| [src/sheet/M1.cls](/src/sheet/M1.cls) | Visual Basic for Applications | 124 | 20 | 24 | 168 |
| [src/sheet/M2.cls](/src/sheet/M2.cls) | Visual Basic for Applications | 294 | 53 | 54 | 401 |
| [src/sheet/O1.cls](/src/sheet/O1.cls) | Visual Basic for Applications | 0 | 5 | 1 | 6 |
| [src/sheet/O2.cls](/src/sheet/O2.cls) | Visual Basic for Applications | 0 | 6 | 1 | 7 |
| [src/sheet/T1.cls](/src/sheet/T1.cls) | Visual Basic for Applications | 28 | 13 | 14 | 55 |
| [src/sheet/T2.cls](/src/sheet/T2.cls) | Visual Basic for Applications | 64 | 19 | 32 | 115 |
| [src/sheet/T3.cls](/src/sheet/T3.cls) | Visual Basic for Applications | 40 | 15 | 20 | 75 |
| [src/sheet/Z1.cls](/src/sheet/Z1.cls) | Visual Basic for Applications | 33 | 15 | 17 | 65 |
| [src/sheet/Z2.cls](/src/sheet/Z2.cls) | Visual Basic for Applications | 28 | 13 | 14 | 55 |
| [src/sheet/Z3.cls](/src/sheet/Z3.cls) | Visual Basic for Applications | 30 | 14 | 14 | 58 |
| [src/sheet/Z4.cls](/src/sheet/Z4.cls) | Visual Basic for Applications | 32 | 15 | 15 | 62 |
[Summary](results.md) / Details / [Diff Summary](diff.md) / [Diff Details](diff-details.md)

48
.VSCodeCounter/2026-04-23_10-41-31/diff-details.md
View File

@@ -1,48 +0,0 @@
# Diff Details
Date : 2026-04-23 10:41:31
Directory d:\\Project\\upds7\\vba\\src
Total : 33 files, 995 codes, 235 comments, 213 blanks, all 1443 lines
[Summary](results.md) / [Details](details.md) / [Diff Summary](diff.md) / Diff Details
## Files
| filename | language | code | comment | blank | total |
| :--- | :--- | ---: | ---: | ---: | ---: |
| [src/init\_module/Import\_modules.bas](/src/init_module/Import_modules.bas) | Visual Basic for Applications | 156 | 13 | 30 | 199 |
| [src/init\_module/Test\_Cache.bas](/src/init_module/Test_Cache.bas) | Visual Basic for Applications | 161 | 12 | 26 | 199 |
| [src/module/Common\_Button.bas](/src/module/Common_Button.bas) | Visual Basic for Applications | 257 | 29 | 73 | 359 |
| [src/module/Common\_File\_Utils.bas](/src/module/Common_File_Utils.bas) | Visual Basic for Applications | 262 | 43 | 43 | 348 |
| [src/module/Common\_Functions.bas](/src/module/Common_Functions.bas) | Visual Basic for Applications | 371 | 42 | 74 | 487 |
| [src/module/Common\_Global\_Cache.bas](/src/module/Common_Global_Cache.bas) | Visual Basic for Applications | 456 | 51 | 80 | 587 |
| [src/module/Common\_Selector.bas](/src/module/Common_Selector.bas) | Visual Basic for Applications | 122 | 22 | 18 | 162 |
| [src/module/Generic\_Master\_Common.bas](/src/module/Generic_Master_Common.bas) | Visual Basic for Applications | -58 | -12 | -17 | -87 |
| [src/module/Global\_Cache.bas](/src/module/Global_Cache.bas) | Visual Basic for Applications | -195 | -43 | -69 | -307 |
| [src/module/Module\_Common.bas](/src/module/Module_Common.bas) | Visual Basic for Applications | -171 | -23 | -35 | -229 |
| [src/module/Read\_Common.bas](/src/module/Read_Common.bas) | Visual Basic for Applications | -153 | -17 | -19 | -189 |
| [src/module/Test\_Cache.bas](/src/module/Test_Cache.bas) | Visual Basic for Applications | -159 | -4 | -25 | -188 |
| [src/module/Write\_Common.bas](/src/module/Write_Common.bas) | Visual Basic for Applications | -106 | -11 | -21 | -138 |
| [src/sheet/C1.cls](/src/sheet/C1.cls) | Visual Basic for Applications | 664 | 83 | 100 | 847 |
| [src/sheet/M1.cls](/src/sheet/M1.cls) | Visual Basic for Applications | 124 | 20 | 24 | 168 |
| [src/sheet/M2.cls](/src/sheet/M2.cls) | Visual Basic for Applications | 294 | 53 | 54 | 401 |
| [src/sheet/O1.cls](/src/sheet/O1.cls) | Visual Basic for Applications | 0 | 5 | 1 | 6 |
| [src/sheet/O2.cls](/src/sheet/O2.cls) | Visual Basic for Applications | 0 | 6 | 1 | 7 |
| [src/sheet/T1.cls](/src/sheet/T1.cls) | Visual Basic for Applications | 28 | 13 | 14 | 55 |
| [src/sheet/T2.cls](/src/sheet/T2.cls) | Visual Basic for Applications | 64 | 19 | 32 | 115 |
| [src/sheet/T3.cls](/src/sheet/T3.cls) | Visual Basic for Applications | 40 | 15 | 20 | 75 |
| [src/sheet/Z1.cls](/src/sheet/Z1.cls) | Visual Basic for Applications | 33 | 15 | 17 | 65 |
| [src/sheet/Z2.cls](/src/sheet/Z2.cls) | Visual Basic for Applications | 28 | 13 | 14 | 55 |
| [src/sheet/Z3.cls](/src/sheet/Z3.cls) | Visual Basic for Applications | 30 | 14 | 14 | 58 |
| [src/sheet/Z4.cls](/src/sheet/Z4.cls) | Visual Basic for Applications | 32 | 15 | 15 | 62 |
| [src/thisWorkbook/Master\_M1\_Kukan.bas](/src/thisWorkbook/Master_M1_Kukan.bas) | Visual Basic for Applications | -234 | -25 | -53 | -312 |
| [src/thisWorkbook/Master\_M2\_Kukan\_detail.bas](/src/thisWorkbook/Master_M2_Kukan_detail.bas) | Visual Basic for Applications | -176 | -32 | -45 | -253 |
| [src/thisWorkbook/Master\_O1\_address.bas](/src/thisWorkbook/Master_O1_address.bas) | Visual Basic for Applications | -35 | -4 | -13 | -52 |
| [src/thisWorkbook/Master\_O2\_507.bas](/src/thisWorkbook/Master_O2_507.bas) | Visual Basic for Applications | -12 | -1 | -4 | -17 |
| [src/thisWorkbook/Master\_Z1\_222.bas](/src/thisWorkbook/Master_Z1_222.bas) | Visual Basic for Applications | -140 | -5 | -27 | -172 |
| [src/thisWorkbook/Master\_Z2\_223.bas](/src/thisWorkbook/Master_Z2_223.bas) | Visual Basic for Applications | -126 | -5 | -25 | -156 |
| [src/thisWorkbook/Master\_Z3\_224.bas](/src/thisWorkbook/Master_Z3_224.bas) | Visual Basic for Applications | -133 | -5 | -26 | -164 |
| [src/thisWorkbook/Tukin\_C1.bas](/src/thisWorkbook/Tukin_C1.bas) | Visual Basic for Applications | -429 | -61 | -58 | -548 |
[Summary](results.md) / [Details](details.md) / [Diff Summary](diff.md) / Diff Details

35
.VSCodeCounter/2026-04-23_10-41-31/diff.csv
View File

@@ -1,35 +0,0 @@
"filename", "language", "Visual Basic for Applications", "comment", "blank", "total"
"d:\Project\upds7\vba\src\init_module\Import_modules.bas", "Visual Basic for Applications", 156, 13, 30, 199
"d:\Project\upds7\vba\src\init_module\Test_Cache.bas", "Visual Basic for Applications", 161, 12, 26, 199
"d:\Project\upds7\vba\src\module\Common_Button.bas", "Visual Basic for Applications", 257, 29, 73, 359
"d:\Project\upds7\vba\src\module\Common_File_Utils.bas", "Visual Basic for Applications", 262, 43, 43, 348
"d:\Project\upds7\vba\src\module\Common_Functions.bas", "Visual Basic for Applications", 371, 42, 74, 487
"d:\Project\upds7\vba\src\module\Common_Global_Cache.bas", "Visual Basic for Applications", 456, 51, 80, 587
"d:\Project\upds7\vba\src\module\Common_Selector.bas", "Visual Basic for Applications", 122, 22, 18, 162
"d:\Project\upds7\vba\src\module\Generic_Master_Common.bas", "Visual Basic for Applications", -58, -12, -17, -87
"d:\Project\upds7\vba\src\module\Global_Cache.bas", "Visual Basic for Applications", -195, -43, -69, -307
"d:\Project\upds7\vba\src\module\Module_Common.bas", "Visual Basic for Applications", -171, -23, -35, -229
"d:\Project\upds7\vba\src\module\Read_Common.bas", "Visual Basic for Applications", -153, -17, -19, -189
"d:\Project\upds7\vba\src\module\Test_Cache.bas", "Visual Basic for Applications", -159, -4, -25, -188
"d:\Project\upds7\vba\src\module\Write_Common.bas", "Visual Basic for Applications", -106, -11, -21, -138
"d:\Project\upds7\vba\src\sheet\C1.cls", "Visual Basic for Applications", 664, 83, 100, 847
"d:\Project\upds7\vba\src\sheet\M1.cls", "Visual Basic for Applications", 124, 20, 24, 168
"d:\Project\upds7\vba\src\sheet\M2.cls", "Visual Basic for Applications", 294, 53, 54, 401
"d:\Project\upds7\vba\src\sheet\O1.cls", "Visual Basic for Applications", 0, 5, 1, 6
"d:\Project\upds7\vba\src\sheet\O2.cls", "Visual Basic for Applications", 0, 6, 1, 7
"d:\Project\upds7\vba\src\sheet\T1.cls", "Visual Basic for Applications", 28, 13, 14, 55
"d:\Project\upds7\vba\src\sheet\T2.cls", "Visual Basic for Applications", 64, 19, 32, 115
"d:\Project\upds7\vba\src\sheet\T3.cls", "Visual Basic for Applications", 40, 15, 20, 75
"d:\Project\upds7\vba\src\sheet\Z1.cls", "Visual Basic for Applications", 33, 15, 17, 65
"d:\Project\upds7\vba\src\sheet\Z2.cls", "Visual Basic for Applications", 28, 13, 14, 55
"d:\Project\upds7\vba\src\sheet\Z3.cls", "Visual Basic for Applications", 30, 14, 14, 58
"d:\Project\upds7\vba\src\sheet\Z4.cls", "Visual Basic for Applications", 32, 15, 15, 62
"d:\Project\upds7\vba\src\thisWorkbook\Master_M1_Kukan.bas", "Visual Basic for Applications", -234, -25, -53, -312
"d:\Project\upds7\vba\src\thisWorkbook\Master_M2_Kukan_detail.bas", "Visual Basic for Applications", -176, -32, -45, -253
"d:\Project\upds7\vba\src\thisWorkbook\Master_O1_address.bas", "Visual Basic for Applications", -35, -4, -13, -52
"d:\Project\upds7\vba\src\thisWorkbook\Master_O2_507.bas", "Visual Basic for Applications", -12, -1, -4, -17
"d:\Project\upds7\vba\src\thisWorkbook\Master_Z1_222.bas", "Visual Basic for Applications", -140, -5, -27, -172
"d:\Project\upds7\vba\src\thisWorkbook\Master_Z2_223.bas", "Visual Basic for Applications", -126, -5, -25, -156
"d:\Project\upds7\vba\src\thisWorkbook\Master_Z3_224.bas", "Visual Basic for Applications", -133, -5, -26, -164
"d:\Project\upds7\vba\src\thisWorkbook\Tukin_C1.bas", "Visual Basic for Applications", -429, -61, -58, -548
"Total", "-", 995, 235, 213, 1443
1 filename language Visual Basic for Applications comment blank total
2 d:\Project\upds7\vba\src\init_module\Import_modules.bas Visual Basic for Applications 156 13 30 199
3 d:\Project\upds7\vba\src\init_module\Test_Cache.bas Visual Basic for Applications 161 12 26 199
4 d:\Project\upds7\vba\src\module\Common_Button.bas Visual Basic for Applications 257 29 73 359
5 d:\Project\upds7\vba\src\module\Common_File_Utils.bas Visual Basic for Applications 262 43 43 348
6 d:\Project\upds7\vba\src\module\Common_Functions.bas Visual Basic for Applications 371 42 74 487
7 d:\Project\upds7\vba\src\module\Common_Global_Cache.bas Visual Basic for Applications 456 51 80 587
8 d:\Project\upds7\vba\src\module\Common_Selector.bas Visual Basic for Applications 122 22 18 162
9 d:\Project\upds7\vba\src\module\Generic_Master_Common.bas Visual Basic for Applications -58 -12 -17 -87
10 d:\Project\upds7\vba\src\module\Global_Cache.bas Visual Basic for Applications -195 -43 -69 -307
11 d:\Project\upds7\vba\src\module\Module_Common.bas Visual Basic for Applications -171 -23 -35 -229
12 d:\Project\upds7\vba\src\module\Read_Common.bas Visual Basic for Applications -153 -17 -19 -189
13 d:\Project\upds7\vba\src\module\Test_Cache.bas Visual Basic for Applications -159 -4 -25 -188
14 d:\Project\upds7\vba\src\module\Write_Common.bas Visual Basic for Applications -106 -11 -21 -138
15 d:\Project\upds7\vba\src\sheet\C1.cls Visual Basic for Applications 664 83 100 847
16 d:\Project\upds7\vba\src\sheet\M1.cls Visual Basic for Applications 124 20 24 168
17 d:\Project\upds7\vba\src\sheet\M2.cls Visual Basic for Applications 294 53 54 401
18 d:\Project\upds7\vba\src\sheet\O1.cls Visual Basic for Applications 0 5 1 6
19 d:\Project\upds7\vba\src\sheet\O2.cls Visual Basic for Applications 0 6 1 7
20 d:\Project\upds7\vba\src\sheet\T1.cls Visual Basic for Applications 28 13 14 55
21 d:\Project\upds7\vba\src\sheet\T2.cls Visual Basic for Applications 64 19 32 115
22 d:\Project\upds7\vba\src\sheet\T3.cls Visual Basic for Applications 40 15 20 75
23 d:\Project\upds7\vba\src\sheet\Z1.cls Visual Basic for Applications 33 15 17 65
24 d:\Project\upds7\vba\src\sheet\Z2.cls Visual Basic for Applications 28 13 14 55
25 d:\Project\upds7\vba\src\sheet\Z3.cls Visual Basic for Applications 30 14 14 58
26 d:\Project\upds7\vba\src\sheet\Z4.cls Visual Basic for Applications 32 15 15 62
27 d:\Project\upds7\vba\src\thisWorkbook\Master_M1_Kukan.bas Visual Basic for Applications -234 -25 -53 -312
28 d:\Project\upds7\vba\src\thisWorkbook\Master_M2_Kukan_detail.bas Visual Basic for Applications -176 -32 -45 -253
29 d:\Project\upds7\vba\src\thisWorkbook\Master_O1_address.bas Visual Basic for Applications -35 -4 -13 -52
30 d:\Project\upds7\vba\src\thisWorkbook\Master_O2_507.bas Visual Basic for Applications -12 -1 -4 -17
31 d:\Project\upds7\vba\src\thisWorkbook\Master_Z1_222.bas Visual Basic for Applications -140 -5 -27 -172
32 d:\Project\upds7\vba\src\thisWorkbook\Master_Z2_223.bas Visual Basic for Applications -126 -5 -25 -156
33 d:\Project\upds7\vba\src\thisWorkbook\Master_Z3_224.bas Visual Basic for Applications -133 -5 -26 -164
34 d:\Project\upds7\vba\src\thisWorkbook\Tukin_C1.bas Visual Basic for Applications -429 -61 -58 -548
35 Total - 995 235 213 1443

25
.VSCodeCounter/2026-04-23_10-41-31/diff.md
View File

@@ -1,25 +0,0 @@
# Diff Summary
Date : 2026-04-23 10:41:31
Directory d:\\Project\\upds7\\vba\\src
Total : 33 files, 995 codes, 235 comments, 213 blanks, all 1443 lines
[Summary](results.md) / [Details](details.md) / Diff Summary / [Diff Details](diff-details.md)
## Languages
| language | files | code | comment | blank | total |
| :--- | ---: | ---: | ---: | ---: | ---: |
| Visual Basic for Applications | 33 | 995 | 235 | 213 | 1,443 |
## Directories
| path | files | code | comment | blank | total |
| :--- | ---: | ---: | ---: | ---: | ---: |
| . | 33 | 995 | 235 | 213 | 1,443 |
| init_module | 2 | 317 | 25 | 56 | 398 |
| module | 11 | 626 | 77 | 102 | 805 |
| sheet | 12 | 1,337 | 271 | 306 | 1,914 |
| thisWorkbook | 8 | -1,285 | -138 | -251 | -1,674 |
[Summary](results.md) / [Details](details.md) / Diff Summary / [Diff Details](diff-details.md)

61
.VSCodeCounter/2026-04-23_10-41-31/diff.txt
View File

@@ -1,61 +0,0 @@
Date : 2026-04-23 10:41:31
Directory : d:\Project\upds7\vba\src
Total : 33 files, 995 codes, 235 comments, 213 blanks, all 1443 lines
Languages
+-------------------------------+------------+------------+------------+------------+------------+
| language | files | code | comment | blank | total |
+-------------------------------+------------+------------+------------+------------+------------+
| Visual Basic for Applications | 33 | 995 | 235 | 213 | 1,443 |
+-------------------------------+------------+------------+------------+------------+------------+
Directories
+------------------------------------------------------------------+------------+------------+------------+------------+------------+
| path | files | code | comment | blank | total |
+------------------------------------------------------------------+------------+------------+------------+------------+------------+
| . | 33 | 995 | 235 | 213 | 1,443 |
| init_module | 2 | 317 | 25 | 56 | 398 |
| module | 11 | 626 | 77 | 102 | 805 |
| sheet | 12 | 1,337 | 271 | 306 | 1,914 |
| thisWorkbook | 8 | -1,285 | -138 | -251 | -1,674 |
+------------------------------------------------------------------+------------+------------+------------+------------+------------+
Files
+------------------------------------------------------------------+-------------------------------+------------+------------+------------+------------+
| filename | language | code | comment | blank | total |
+------------------------------------------------------------------+-------------------------------+------------+------------+------------+------------+
| d:\Project\upds7\vba\src\init_module\Import_modules.bas | Visual Basic for Applications | 156 | 13 | 30 | 199 |
| d:\Project\upds7\vba\src\init_module\Test_Cache.bas | Visual Basic for Applications | 161 | 12 | 26 | 199 |
| d:\Project\upds7\vba\src\module\Common_Button.bas | Visual Basic for Applications | 257 | 29 | 73 | 359 |
| d:\Project\upds7\vba\src\module\Common_File_Utils.bas | Visual Basic for Applications | 262 | 43 | 43 | 348 |
| d:\Project\upds7\vba\src\module\Common_Functions.bas | Visual Basic for Applications | 371 | 42 | 74 | 487 |
| d:\Project\upds7\vba\src\module\Common_Global_Cache.bas | Visual Basic for Applications | 456 | 51 | 80 | 587 |
| d:\Project\upds7\vba\src\module\Common_Selector.bas | Visual Basic for Applications | 122 | 22 | 18 | 162 |
| d:\Project\upds7\vba\src\module\Generic_Master_Common.bas | Visual Basic for Applications | -58 | -12 | -17 | -87 |
| d:\Project\upds7\vba\src\module\Global_Cache.bas | Visual Basic for Applications | -195 | -43 | -69 | -307 |
| d:\Project\upds7\vba\src\module\Module_Common.bas | Visual Basic for Applications | -171 | -23 | -35 | -229 |
| d:\Project\upds7\vba\src\module\Read_Common.bas | Visual Basic for Applications | -153 | -17 | -19 | -189 |
| d:\Project\upds7\vba\src\module\Test_Cache.bas | Visual Basic for Applications | -159 | -4 | -25 | -188 |
| d:\Project\upds7\vba\src\module\Write_Common.bas | Visual Basic for Applications | -106 | -11 | -21 | -138 |
| d:\Project\upds7\vba\src\sheet\C1.cls | Visual Basic for Applications | 664 | 83 | 100 | 847 |
| d:\Project\upds7\vba\src\sheet\M1.cls | Visual Basic for Applications | 124 | 20 | 24 | 168 |
| d:\Project\upds7\vba\src\sheet\M2.cls | Visual Basic for Applications | 294 | 53 | 54 | 401 |
| d:\Project\upds7\vba\src\sheet\O1.cls | Visual Basic for Applications | 0 | 5 | 1 | 6 |
| d:\Project\upds7\vba\src\sheet\O2.cls | Visual Basic for Applications | 0 | 6 | 1 | 7 |
| d:\Project\upds7\vba\src\sheet\T1.cls | Visual Basic for Applications | 28 | 13 | 14 | 55 |
| d:\Project\upds7\vba\src\sheet\T2.cls | Visual Basic for Applications | 64 | 19 | 32 | 115 |
| d:\Project\upds7\vba\src\sheet\T3.cls | Visual Basic for Applications | 40 | 15 | 20 | 75 |
| d:\Project\upds7\vba\src\sheet\Z1.cls | Visual Basic for Applications | 33 | 15 | 17 | 65 |
| d:\Project\upds7\vba\src\sheet\Z2.cls | Visual Basic for Applications | 28 | 13 | 14 | 55 |
| d:\Project\upds7\vba\src\sheet\Z3.cls | Visual Basic for Applications | 30 | 14 | 14 | 58 |
| d:\Project\upds7\vba\src\sheet\Z4.cls | Visual Basic for Applications | 32 | 15 | 15 | 62 |
| d:\Project\upds7\vba\src\thisWorkbook\Master_M1_Kukan.bas | Visual Basic for Applications | -234 | -25 | -53 | -312 |
| d:\Project\upds7\vba\src\thisWorkbook\Master_M2_Kukan_detail.bas | Visual Basic for Applications | -176 | -32 | -45 | -253 |
| d:\Project\upds7\vba\src\thisWorkbook\Master_O1_address.bas | Visual Basic for Applications | -35 | -4 | -13 | -52 |
| d:\Project\upds7\vba\src\thisWorkbook\Master_O2_507.bas | Visual Basic for Applications | -12 | -1 | -4 | -17 |
| d:\Project\upds7\vba\src\thisWorkbook\Master_Z1_222.bas | Visual Basic for Applications | -140 | -5 | -27 | -172 |
| d:\Project\upds7\vba\src\thisWorkbook\Master_Z2_223.bas | Visual Basic for Applications | -126 | -5 | -25 | -156 |
| d:\Project\upds7\vba\src\thisWorkbook\Master_Z3_224.bas | Visual Basic for Applications | -133 | -5 | -26 | -164 |
| d:\Project\upds7\vba\src\thisWorkbook\Tukin_C1.bas | Visual Basic for Applications | -429 | -61 | -58 | -548 |
| Total | | 995 | 235 | 213 | 1,443 |
+------------------------------------------------------------------+-------------------------------+------------+------------+------------+------------+

21
.VSCodeCounter/2026-04-23_10-41-31/results.csv
View File

@@ -1,21 +0,0 @@
"filename", "language", "Visual Basic for Applications", "comment", "blank", "total"
"d:\Project\upds7\vba\src\init_module\Import_modules.bas", "Visual Basic for Applications", 156, 13, 30, 199
"d:\Project\upds7\vba\src\init_module\Test_Cache.bas", "Visual Basic for Applications", 161, 12, 26, 199
"d:\Project\upds7\vba\src\module\Common_Button.bas", "Visual Basic for Applications", 257, 29, 73, 359
"d:\Project\upds7\vba\src\module\Common_File_Utils.bas", "Visual Basic for Applications", 262, 43, 43, 348
"d:\Project\upds7\vba\src\module\Common_Functions.bas", "Visual Basic for Applications", 371, 42, 74, 487
"d:\Project\upds7\vba\src\module\Common_Global_Cache.bas", "Visual Basic for Applications", 456, 51, 80, 587
"d:\Project\upds7\vba\src\module\Common_Selector.bas", "Visual Basic for Applications", 122, 22, 18, 162
"d:\Project\upds7\vba\src\sheet\C1.cls", "Visual Basic for Applications", 664, 83, 100, 847
"d:\Project\upds7\vba\src\sheet\M1.cls", "Visual Basic for Applications", 124, 20, 24, 168
"d:\Project\upds7\vba\src\sheet\M2.cls", "Visual Basic for Applications", 294, 53, 54, 401
"d:\Project\upds7\vba\src\sheet\O1.cls", "Visual Basic for Applications", 0, 5, 1, 6
"d:\Project\upds7\vba\src\sheet\O2.cls", "Visual Basic for Applications", 0, 6, 1, 7
"d:\Project\upds7\vba\src\sheet\T1.cls", "Visual Basic for Applications", 28, 13, 14, 55
"d:\Project\upds7\vba\src\sheet\T2.cls", "Visual Basic for Applications", 64, 19, 32, 115
"d:\Project\upds7\vba\src\sheet\T3.cls", "Visual Basic for Applications", 40, 15, 20, 75
"d:\Project\upds7\vba\src\sheet\Z1.cls", "Visual Basic for Applications", 33, 15, 17, 65
"d:\Project\upds7\vba\src\sheet\Z2.cls", "Visual Basic for Applications", 28, 13, 14, 55
"d:\Project\upds7\vba\src\sheet\Z3.cls", "Visual Basic for Applications", 30, 14, 14, 58
"d:\Project\upds7\vba\src\sheet\Z4.cls", "Visual Basic for Applications", 32, 15, 15, 62
"Total", "-", 3122, 483, 650, 4255
1 filename language Visual Basic for Applications comment blank total
2 d:\Project\upds7\vba\src\init_module\Import_modules.bas Visual Basic for Applications 156 13 30 199
3 d:\Project\upds7\vba\src\init_module\Test_Cache.bas Visual Basic for Applications 161 12 26 199
4 d:\Project\upds7\vba\src\module\Common_Button.bas Visual Basic for Applications 257 29 73 359
5 d:\Project\upds7\vba\src\module\Common_File_Utils.bas Visual Basic for Applications 262 43 43 348
6 d:\Project\upds7\vba\src\module\Common_Functions.bas Visual Basic for Applications 371 42 74 487
7 d:\Project\upds7\vba\src\module\Common_Global_Cache.bas Visual Basic for Applications 456 51 80 587
8 d:\Project\upds7\vba\src\module\Common_Selector.bas Visual Basic for Applications 122 22 18 162
9 d:\Project\upds7\vba\src\sheet\C1.cls Visual Basic for Applications 664 83 100 847
10 d:\Project\upds7\vba\src\sheet\M1.cls Visual Basic for Applications 124 20 24 168
11 d:\Project\upds7\vba\src\sheet\M2.cls Visual Basic for Applications 294 53 54 401
12 d:\Project\upds7\vba\src\sheet\O1.cls Visual Basic for Applications 0 5 1 6
13 d:\Project\upds7\vba\src\sheet\O2.cls Visual Basic for Applications 0 6 1 7
14 d:\Project\upds7\vba\src\sheet\T1.cls Visual Basic for Applications 28 13 14 55
15 d:\Project\upds7\vba\src\sheet\T2.cls Visual Basic for Applications 64 19 32 115
16 d:\Project\upds7\vba\src\sheet\T3.cls Visual Basic for Applications 40 15 20 75
17 d:\Project\upds7\vba\src\sheet\Z1.cls Visual Basic for Applications 33 15 17 65
18 d:\Project\upds7\vba\src\sheet\Z2.cls Visual Basic for Applications 28 13 14 55
19 d:\Project\upds7\vba\src\sheet\Z3.cls Visual Basic for Applications 30 14 14 58
20 d:\Project\upds7\vba\src\sheet\Z4.cls Visual Basic for Applications 32 15 15 62
21 Total - 3122 483 650 4255

1
.VSCodeCounter/2026-04-23_10-41-31/results.json
View File

@@ -1 +0,0 @@
{"file:///d%3A/Project/upds7/vba/src/sheet/Z4.cls":{"language":"Visual Basic for Applications","code":32,"comment":15,"blank":15},"file:///d%3A/Project/upds7/vba/src/sheet/Z2.cls":{"language":"Visual Basic for Applications","code":28,"comment":13,"blank":14},"file:///d%3A/Project/upds7/vba/src/sheet/Z3.cls":{"language":"Visual Basic for Applications","code":30,"comment":14,"blank":14},"file:///d%3A/Project/upds7/vba/src/sheet/Z1.cls":{"language":"Visual Basic for Applications","code":33,"comment":15,"blank":17},"file:///d%3A/Project/upds7/vba/src/sheet/T3.cls":{"language":"Visual Basic for Applications","code":40,"comment":15,"blank":20},"file:///d%3A/Project/upds7/vba/src/sheet/T1.cls":{"language":"Visual Basic for Applications","code":28,"comment":13,"blank":14},"file:///d%3A/Project/upds7/vba/src/sheet/T2.cls":{"language":"Visual Basic for Applications","code":64,"comment":19,"blank":32},"file:///d%3A/Project/upds7/vba/src/sheet/O2.cls":{"language":"Visual Basic for Applications","code":0,"comment":6,"blank":1},"file:///d%3A/Project/upds7/vba/src/sheet/M1.cls":{"language":"Visual Basic for Applications","code":124,"comment":20,"blank":24},"file:///d%3A/Project/upds7/vba/src/sheet/O1.cls":{"language":"Visual Basic for Applications","code":0,"comment":5,"blank":1},"file:///d%3A/Project/upds7/vba/src/sheet/C1.cls":{"language":"Visual Basic for Applications","code":664,"comment":83,"blank":100},"file:///d%3A/Project/upds7/vba/src/module/Common_Functions.bas":{"language":"Visual Basic for Applications","code":371,"comment":42,"blank":74},"file:///d%3A/Project/upds7/vba/src/sheet/M2.cls":{"language":"Visual Basic for Applications","code":294,"comment":53,"blank":54},"file:///d%3A/Project/upds7/vba/src/module/Common_File_Utils.bas":{"language":"Visual Basic for Applications","code":262,"comment":43,"blank":43},"file:///d%3A/Project/upds7/vba/src/module/Common_Button.bas":{"language":"Visual Basic for Applications","code":257,"comment":29,"blank":73},"file:///d%3A/Project/upds7/vba/src/init_module/Import_modules.bas":{"language":"Visual Basic for Applications","code":156,"comment":13,"blank":30},"file:///d%3A/Project/upds7/vba/src/init_module/Test_Cache.bas":{"language":"Visual Basic for Applications","code":161,"comment":12,"blank":26},"file:///d%3A/Project/upds7/vba/src/module/Common_Global_Cache.bas":{"language":"Visual Basic for Applications","code":456,"comment":51,"blank":80},"file:///d%3A/Project/upds7/vba/src/module/Common_Selector.bas":{"language":"Visual Basic for Applications","code":122,"comment":22,"blank":18}}

24
.VSCodeCounter/2026-04-23_10-41-31/results.md
View File

@@ -1,24 +0,0 @@
# Summary
Date : 2026-04-23 10:41:31
Directory d:\\Project\\upds7\\vba\\src
Total : 19 files, 3122 codes, 483 comments, 650 blanks, all 4255 lines
Summary / [Details](details.md) / [Diff Summary](diff.md) / [Diff Details](diff-details.md)
## Languages
| language | files | code | comment | blank | total |
| :--- | ---: | ---: | ---: | ---: | ---: |
| Visual Basic for Applications | 19 | 3,122 | 483 | 650 | 4,255 |
## Directories
| path | files | code | comment | blank | total |
| :--- | ---: | ---: | ---: | ---: | ---: |
| . | 19 | 3,122 | 483 | 650 | 4,255 |
| init_module | 2 | 317 | 25 | 56 | 398 |
| module | 5 | 1,468 | 187 | 288 | 1,943 |
| sheet | 12 | 1,337 | 271 | 306 | 1,914 |
Summary / [Details](details.md) / [Diff Summary](diff.md) / [Diff Details](diff-details.md)

46
.VSCodeCounter/2026-04-23_10-41-31/results.txt
View File

@@ -1,46 +0,0 @@
Date : 2026-04-23 10:41:31
Directory : d:\Project\upds7\vba\src
Total : 19 files, 3122 codes, 483 comments, 650 blanks, all 4255 lines
Languages
+-------------------------------+------------+------------+------------+------------+------------+
| language | files | code | comment | blank | total |
+-------------------------------+------------+------------+------------+------------+------------+
| Visual Basic for Applications | 19 | 3,122 | 483 | 650 | 4,255 |
+-------------------------------+------------+------------+------------+------------+------------+
Directories
+---------------------------------------------------------+------------+------------+------------+------------+------------+
| path | files | code | comment | blank | total |
+---------------------------------------------------------+------------+------------+------------+------------+------------+
| . | 19 | 3,122 | 483 | 650 | 4,255 |
| init_module | 2 | 317 | 25 | 56 | 398 |
| module | 5 | 1,468 | 187 | 288 | 1,943 |
| sheet | 12 | 1,337 | 271 | 306 | 1,914 |
+---------------------------------------------------------+------------+------------+------------+------------+------------+
Files
+---------------------------------------------------------+-------------------------------+------------+------------+------------+------------+
| filename | language | code | comment | blank | total |
+---------------------------------------------------------+-------------------------------+------------+------------+------------+------------+
| d:\Project\upds7\vba\src\init_module\Import_modules.bas | Visual Basic for Applications | 156 | 13 | 30 | 199 |
| d:\Project\upds7\vba\src\init_module\Test_Cache.bas | Visual Basic for Applications | 161 | 12 | 26 | 199 |
| d:\Project\upds7\vba\src\module\Common_Button.bas | Visual Basic for Applications | 257 | 29 | 73 | 359 |
| d:\Project\upds7\vba\src\module\Common_File_Utils.bas | Visual Basic for Applications | 262 | 43 | 43 | 348 |
| d:\Project\upds7\vba\src\module\Common_Functions.bas | Visual Basic for Applications | 371 | 42 | 74 | 487 |
| d:\Project\upds7\vba\src\module\Common_Global_Cache.bas | Visual Basic for Applications | 456 | 51 | 80 | 587 |
| d:\Project\upds7\vba\src\module\Common_Selector.bas | Visual Basic for Applications | 122 | 22 | 18 | 162 |
| d:\Project\upds7\vba\src\sheet\C1.cls | Visual Basic for Applications | 664 | 83 | 100 | 847 |
| d:\Project\upds7\vba\src\sheet\M1.cls | Visual Basic for Applications | 124 | 20 | 24 | 168 |
| d:\Project\upds7\vba\src\sheet\M2.cls | Visual Basic for Applications | 294 | 53 | 54 | 401 |
| d:\Project\upds7\vba\src\sheet\O1.cls | Visual Basic for Applications | 0 | 5 | 1 | 6 |
| d:\Project\upds7\vba\src\sheet\O2.cls | Visual Basic for Applications | 0 | 6 | 1 | 7 |
| d:\Project\upds7\vba\src\sheet\T1.cls | Visual Basic for Applications | 28 | 13 | 14 | 55 |
| d:\Project\upds7\vba\src\sheet\T2.cls | Visual Basic for Applications | 64 | 19 | 32 | 115 |
| d:\Project\upds7\vba\src\sheet\T3.cls | Visual Basic for Applications | 40 | 15 | 20 | 75 |
| d:\Project\upds7\vba\src\sheet\Z1.cls | Visual Basic for Applications | 33 | 15 | 17 | 65 |
| d:\Project\upds7\vba\src\sheet\Z2.cls | Visual Basic for Applications | 28 | 13 | 14 | 55 |
| d:\Project\upds7\vba\src\sheet\Z3.cls | Visual Basic for Applications | 30 | 14 | 14 | 58 |
| d:\Project\upds7\vba\src\sheet\Z4.cls | Visual Basic for Applications | 32 | 15 | 15 | 62 |
| Total | | 3,122 | 483 | 650 | 4,255 |
+---------------------------------------------------------+-------------------------------+------------+------------+------------+------------+

102
AGENTS.md Normal file
View File

@@ -0,0 +1,102 @@
# 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 completely forbidden. Missing sheet/object should raise error directly via `Err.Raise ERR_SHEET_MISSING`. Do not suppress errors when checking if a sheet/worksheet/object exists.
- ✅ 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
- ✅ Comments must be in **English only**. No Chinese, Japanese, or Korean characters allowed in any code comments or inline documentation
- ❌ Forbidden: `Select` / `Selection` / `ActiveCell`. Always reference Range/Worksheet objects directly
- ❌ Forbidden: hardcoded file paths or connection strings. Use config sheet or constants module
- ❌ Forbidden: non-English comments (Chinese / Japanese / Korean)
### Code Review Checklist
**Before editing**
- Read the entire function from first line to last line (not just the lines you plan to change)
- Find all call sites that reference the function or data structure you are about to modify
**After editing**
- Read the entire function from first line to last line again
- Verify: are all variables declared, are scopes correct, is the logic complete
- Go through every call site one by one to confirm compatibility
**When the user asks "Are you sure?"**
- Actually re-read the relevant code instead of saying "looks fine"
- grep all references and verify them one by one
**Key principle**
- Never skip context — do not look at only the diff and call it done
- The compiler cannot catch logic errors or missing variable declarations — only human review can
- Read the whole function, read all call sites — no exceptions
## Design Document
**Primary reference**: `documents/Tukin_Design_Document.md`
Before editing any sheet class or cache logic, **read the design document first**. It contains:
- Sheet column layouts with HeaderRow/StartRow/StartCol/EndCol per `RefreshSheetDict`
- Cache key/value structures for every CACHE_* constant
- Data flow diagrams for C1 editing cascade and CSV import
- Column layout reference (C1 has 58 columns, C to BG)
- All known issues and their fix status
**Rule**: Do not guess sheet layout or cache structure. Look it up in the design document.
**When cache structure is modified**: Update the design document accordingly — including CACHE_* constant table, cache architecture section, and any affected data flow diagrams.
vba/
AGENTS.md, README.md, .gitignore, LICENSE
通勤手当テンプレート2026xxxx.xlsm (latest date version)
data/ CSV master data (14 files)
documents/ design docs
Tukin_Design_Document.md — master design doc: sheet layouts, cache architecture, column reference, data flow
checklist-2026-05-27.md — audit checklist (historical)
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) - (220) notification reason
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 - (221) route station name
Sheet class prefixes: C=commuter editing, M=section master, O=other, T=commuter route, Z=master config

2
README.md
View File

@@ -36,7 +36,7 @@ vba/
├── Z1.cls (64 lines) - Master_222: 交通機関マスタ
├── Z2.cls (54 lines) - Master_223: 決定事項マスタ
├── Z3.cls (57 lines) - Master_224: 手当月額決定区分マスタ
└── Z4.cls (61 lines) - Master_225
└── O3.cls (61 lines) - Master_225
```
## Sheet Class Prefix

4
data/221利用区間発着名区分.csv Normal file
View File

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

81
documents/Tukin_C1_Action.md
View File

@@ -1,81 +0,0 @@
# Tukin_C1 ユーザーアクションドキュメント
## 列アクションのマッピング
### C列 (職員番号)
- **トリガー条件**: C列 >= 第7行、内容変化
- **アクション**:
- 内容が空 → `ClearRowData` で一行クリア
- 内容あり → `FillAddressFromO1` で住所ドロップダウン + 4区間の交通機関ドロップダウン生成
---
### 区間1
| 列 | アクション | トリガー条件 | 処理ロジック |
|---|---|---|---|
| **T** (交通機関) | 交通機関ドロップダウン変化 | Column=20 | `CreateZ1StationDropdown` → U列(発)ドロップダウン生成 |
| **U** (利用区間発) | 発ドロップダウン変化 | Column=21 | `CreateM1KukanDDropdown` → V列(着)ドロップダウン生成 |
| **S** (区間コード) | 区間コード入力 | Column=19 | T列ドロップダウン生成 → T列値ありの場合U,Vを填充 + W列(券種)ドロップダウン生成 |
| **W** (券種) | 券種ドロップダウン変化 | Column=23 | `CreateM2CodeDropdown` → X列(コード)ドロップダウン生成 |
---
### 区間2
| 列 | アクション | トリガー条件 | 処理ロジック |
|---|---|---|---|
| **AA** (交通機関) | 交通機関ドロップダウン変化 | Column=27 | `CreateZ1StationDropdown` → AB列(発)ドロップダウン生成 |
| **AB** (利用区間発) | 発ドロップダウン変化 | Column=28 | `CreateM1KukanDDropdown` → AC列(着)ドロップダウン生成 |
| **Z** (区間コード) | 区間コード入力 | Column=26 | AA列ドロップダウン生成 → AA列値ありの場合AB,ACを填充 + AD列(券種)ドロップダウン生成 |
| **AD** (券種) | 券種ドロップダウン変化 | Column=30 | `CreateM2CodeDropdown` → AE列(コード)ドロップダウン生成 |
---
### 区間3
| 列 | アクション | トリガー条件 | 処理ロジック |
|---|---|---|---|
| **AH** (交通機関) | 交通機関ドロップダウン変化 | Column=34 | `CreateZ1StationDropdown` → AI列(発)ドロップダウン生成 |
| **AI** (利用区間発) | 発ドロップダウン変化 | Column=35 | `CreateM1KukanDDropdown` → AJ列(着)ドロップダウン生成 |
| **AG** (区間コード) | 区間コード入力 | Column=33 | AH列ドロップダウン生成 → AH列値ありの場合AI,AJを填充 + AK列(券種)ドロップダウン生成 |
| **AK** (券種) | 券種ドロップダウン変化 | Column=37 | `CreateM2CodeDropdown` → AL列(コード)ドロップダウン生成 |
---
### 区間4
| 列 | アクション | トリガー条件 | 処理ロジック |
|---|---|---|---|
| **AO** (交通機関) | 交通機関ドロップダウン変化 | Column=41 | `CreateZ1StationDropdown` → AP列(発)ドロップダウン生成 |
| **AP** (利用区間発) | 発ドロップダウン変化 | Column=42 | `CreateM1KukanDDropdown` → AQ列(着)ドロップダウン生成 |
| **AN** (区間コード) | 区間コード入力 | Column=40 | AO列ドロップダウン生成 → AO列値ありの場合AP,AQを填充 + AR列(券種)ドロップダウン生成 |
| **AR** (券種) | 券種ドロップダウン変化 | Column=44 | `CreateM2CodeDropdown` → AS列(コード)ドロップダウン生成 |
---
## メソッド一覧
| メソッド名 | 機能 |
|---|---|
| `FillAddressFromO1` | 職員番号(C列)をキーとしてO1キャッシュから住所(I列)ドロップダウン生成 |
| `CreateZ1TransportDropdown` | 交通機関ドロップダウン生成 |
| `CreateZ1StationDropdown` | 交通機関をキーとしてZ1キャッシュから発ドロップダウン生成 |
| `CreateM1KukanDDropdown` | 交通機関+発をキーとしてM1KukanDキャッシュから着ドロップダウン生成 |
| `FillKukanFromM1` | 区間コードをキーとしてM1キャッシュから区間情報(T/U/V等)填充 |
| `CreateM2Dropdown` | 区間コードをキーとして券種ドロップダウン生成 |
| `CreateM2CodeDropdown` | 区間コード+券種をキーとしてコードドロップダウン生成 |
| `ClearRowData` | 一行データクリア |
| `ClearKukanValidation` | 指定列の検証ドロップダウンをクリア |
---
## キャッシュ依存
| キャッシュ | 用途 |
|---|---|
| `o1Cache` | 職員番号 → 住所 |
| `z1Cache` | 交通機関 → 駅 |
| `m1KukanDCache` | 交通機関+発 → 着 |
| `m1Cache` | 区間コード → 区間情報 |
| `m2Cache` | 区間コード+券種 → コード |

71
documents/Tukin_C1_Mapping.md
View File

@@ -1,71 +0,0 @@
### 届出情報
|列|C列|D列|E列|F列|G列|H列|
|--------|--------|--------|--------|--------|--------|--------|
|ヘッダ|職員番号|事実発生年月日|提出年月日|受理年月日|届出の事由コード|届出の備考|
|データ型|8|日付|日付|日付|Enum|文字列|
### 住所情報
|列|I列|J列|
|--------|--------|--------|
|ヘッダ|住所１|住所２|
|データ型|文字列|文字列|
### 出勤情報
|列|K列|L列|M列|N列|O列|
|--------|--------|--------|--------|--------|--------|
|ヘッダ|運賃改正・法改正年月日|出勤予定日数|往復区分|交替制|算出式|
|データ型|日付|数字|Enum|Enum|文字列|
### 自動車等情報
|列|P列|Q列|R列|
|--------|--------|--------|--------|
|ヘッダ|自動車等使用距離|自動車等支給額|自動車等駐車場代|
|データ型|数字|数字|数字|
### 区間１情報
|列|S列|T列|U列|V列|W列|X列|Y列|
|--------|--------|--------|--------|--------|--------|--------|--------|
|ヘッダ|区間１区間コード|区間１交通機関|区間１発|区間１着|区間１券種|区間１コード|区間１支給開始年月|
|データ型|5|3|文字列|文字列|Enum|3|日付|
### 区間２情報
|列|Z列|AA列|AB列|AC列|AD列|AE列|AF列|
|--------|--------|--------|--------|--------|--------|--------|--------|
|ヘッダ|区間２区間コード|区間２交通機関|区間２発|区間２着|区間２券種|区間２コード|区間２支給開始年月|
|データ型|5|3|文字列|文字列|Enum|3|日付|
### 区間３情報
|列|AG列|AH列|AI列|AJ列|AK列|AL列|AM列|
|--------|--------|--------|--------|--------|--------|--------|--------|
|ヘッダ|区間３区間コード|区間３交通機関|区間３発|区間３着|区間３券種|区間３コード|区間３支給開始年月|
|データ型|5|3|文字列|文字列|Enum|3|日付|
### 区間４情報
|列|AN列|AO列|AP列|AQ列|AR列|AS列|AT列|
|--------|--------|--------|--------|--------|--------|--------|--------|
|ヘッダ|区間４区間コード|区間４交通機関|区間４発|区間４着|区間４券種|区間４コード|区間４支給開始年月|
|データ型|5|3|文字列|文字列|Enum|3|日付|
### 決定事項情報
|列|AU列|AV列|AW列|AX列|
|--------|--------|--------|--------|--------|
|ヘッダ|決定事項区分コード|非該当の理由|非該当者認定簿出力区分|手当月額の決定区分コード|
|データ型|Enum|文字列|Enum|Enum|
### 備考情報
|列|AY列|AZ列|BA列|
|--------|--------|--------|--------|
|ヘッダ|支給の始期|備考|所属コード|
|データ型|日付|文字列|文字列|
### 認定情報
|列|BB列|BC列|
|--------|--------|--------|
|ヘッダ|認定年月日|（各庁の長）官職コード|
|データ型|日付|ENUM|
### エラーメッセージ
|列|BD列|
|--------|--------|
|ヘッダ|エラーメッセージ|
|データ型|文字列|

45
documents/Tukin_Cache_Mapping.md
View File

@@ -1,45 +0,0 @@
# Tukin キャッシュ マッピング
## キャッシュ一覧
### m1Cache
|列|C列|D列|E列|F列|G列|I列|L列|
|--------|--------|--------|--------|--------|--------|--------|--------|
|ヘッダ|区間コード|交通機関区分|交通機関名称|利用区間発名|利用区間着名|券種|運賃|
### m1KukanDCache
|列|D列|F列|G列|
|--------|--------|--------|--------|
|ヘッダ|交通機関区分|利用区間発名|利用区間着名|
### m2Cache
|列|C列|I列|J列|K列|
|--------|--------|--------|--------|--------|
|ヘッダ|区間コード|券種|コード|名称|
### z1Cache (222)交通機関マスタ
|列|C列|D列|
|--------|--------|--------|
|ヘッダ|区分|交通機関名称|
### z2Cache (223)通勤_決定事項区分一覧
|列|C列|D列|
|--------|--------|--------|
|ヘッダ|区分|決定事項|
### z3Cache (224)通勤_手当月額の決定区分一覧
|列|C列|D列|
|--------|--------|--------|
|ヘッダ|区分|手当月額の決定|
### t1Cache
### o1Cache 住所情報
|列|C列|E列|F列|
|--------|--------|--------|--------|
|ヘッダ|職員番号|住所１|住所２|
### o2Cache (507)発信者一覧
|列|C列|D列|
|--------|--------|--------|
|ヘッダ|区分|官職名称|

373
documents/Tukin_Design_Document.md Normal file
View File

@@ -0,0 +1,373 @@
# Commuter Allowance Editor — Design Document
## 1. Project Overview
| Item | Value |
|------|-------|
| Application | Excel 2021 (.xlsm) |
| Purpose | Edit commuter certification by referencing master data |
| Module | tuk (通勤 = commutation) |
| Entry Point | メインメニュー (Main Menu sheet) |
---
## 2. Sheet Inventory
### 2.1 Editor Sheets
#### C1 — 通勤手当CSV編集 (Commuter Allowance Editor)
- **HeaderRow**: 6 | **StartRow**: 8 | **StartCol**: C | **EndCol**: BC
- **Encoding**: shift_jis | **HasHeader**: Yes
- **Role**: Main editing sheet — direct cell editing only, no CSV import
- **Key columns**:
- C: 職員番号 (Employee ID) — triggers address + transport dropdowns
- S/AA/AI/AQ: 区間N区間コード (Section N Route Code) — triggers fill from M1 + dropdown cascade
- T/AB/AJ/AR: 区間N交通機関 (Section N Transport Type)
- U/AC/AK/AS: 区間N発 (Section N Departure Station)
- V/AD/AL/AT: 区間N着 (Section N Arrival Station)
- W/AE/AM/AU: 区間N券種 (Section N Ticket Type)
- X/AF/AN/AV: 区間Nコード (Section N Code)
- AY: 決定事項区分コード (Determination Category)
- BB: 手当月額の決定区分コード (Monthly Amount Decision Category)
#### M1 — 区間メンテナンス (Route Maintenance)
- **HeaderRow**: 5 | **StartRow**: 7 | **StartCol**: C | **EndCol**: N
- **Encoding**: shift_jis | **HasHeader**: Yes
- **Role**: Route master — defines routes (code → transport + departure + arrival + fare)
- **Key columns**:
- C: 利用区間コード (Route Code)
- D: 交通機関区分 (Transport Category)
- E: 交通機関名称 (Transport Name)
- F: 利用区間発名 (Departure Station)
- G: 利用区間着名 (Arrival Station)
- I: 運賃 (Fare)
- J: 現金の場合の1箇月運賃 (Monthly Fare Cash)
- K: 連絡 (Connection)
- L: 特別料金区分 (Special Fare Category)
- M: 特別料金券種 (Special Fare Ticket Type)
- N: 特別料金負担額 (Special Fare Burden Amount)
#### M2 — 区間詳細メンテナンス (Route Detail Maintenance)
- **HeaderRow**: 6 | **StartRow**: 8 | **StartCol**: C | **EndCol**: R
- **Encoding**: shift_jis | **HasHeader**: Yes
- **Role**: Route detail master — ticket types and pricing per route code
- **Key columns**:
- C: 利用区間コード (Route Code) — join key with M1
- I: 券種 (Ticket Type: 0=普通, 1=定期券, 2=回数券, 3=プリペイドカード)
- J: コード (Ticket Code)
- K: 名称 (Ticket Name)
- L: 1箇月運賃/販売額 (Monthly Fare / Sales Price)
- M: 定期額/券１(額)/利用額 (Monthly / Ticket1 Amount / Usage Amount)
- N: 定期支給期間/券１(枚)/特別料金 (Monthly Issue Period / Ticket1 Qty / Special Fare)
- O: 特別料金/券２(額) (Special Fare / Ticket2 Amount)
- P: 券２(枚) (Ticket2 Quantity)
- Q: 端数(額) (Fractional Amount)
- R: 特別料金 (Special Fare)
### 2.2 Master / Config Sheets (Z-series)
#### Z1 — (222)交通機関マスタ (Transport Master)
- **HeaderRow**: 5 | **StartRow**: 7 | **StartCol**: C | **EndCol**: I
- **Encoding**: utf-8 | **HasHeader**: No
- **Role**: Transport type catalog (dropdown source for C1 T/AB/AJ/AR)
- **Columns**: C=区分 (code), D=交通機関名称 (name), E=ポップアップ名称, F=コメント, G=略式名称, H=表示しない, I=略称
#### Z2 — (223)通勤_決定事項区分一覧 (Determination Category List)
- **HeaderRow**: 5 | **StartRow**: 7 | **StartCol**: C | **EndCol**: G
- **Encoding**: utf-8 | **HasHeader**: No
- **Role**: Determination categories for AY column dropdown
- **Columns**: C=区分 (code), D=画面用名称, E=ポップアップ用名称, F=コメント, G=表示しない
#### Z3 — (224)通勤_手当月額の決定区分一覧 (Monthly Amount Decision Category List)
- **HeaderRow**: 5 | **StartRow**: 7 | **StartCol**: C | **EndCol**: H
- **Encoding**: utf-8 | **HasHeader**: No
- **Role**: Monthly amount decision categories for BB column dropdown
- **Columns**: C=区分 (code), D=画面用名称, E=ポップアップ用名称, F=コメント, G=表示しない, H=名称２
#### Z4 — (221)利用区間発着名区分 (Route Station Name Category)
- **HeaderRow**: 5 | **StartRow**: 7 | **StartCol**: C | **EndCol**: H
- **Encoding**: utf-8 | **HasHeader**: No
- **Role**: Station name catalog grouped by line (rosen). Used for M1 F/G column dropdowns.
- **Columns**: C=区分 (station code), D=画面用名称/駅名 (station display name), E=ポップアップ名称, F=コメント/路線名 (line name), G=正式名称, H=表示しない
- **Note**: E column (ポップアップ名称) is populated but currently ignored by code. Code reads F (路線名) and D (駅名) only.
### 2.3 Ticket Master Sheets (T-series)
#### T1 — (244)通勤_定期券名称区分一覧 (Commuter Pass Name Category)
- **HeaderRow**: 5 | **StartRow**: 7 | **StartCol**: C | **EndCol**: G
- **Encoding**: utf-8 | **HasHeader**: No
- **Role**: Periodic commuter pass types (dropdown source for W/AE/AM/AU)
- **Columns**: C=区分 (code), D=画面用名称, E=ポップアップ用名称, F=コメント, G=表示しない
#### T2 — (245)通勤_回数券名称区分一覧 (Fare Ticket Name Category)
- **HeaderRow**: 5 | **StartRow**: 7 | **StartCol**: C | **EndCol**: M
- **Encoding**: utf-8 | **HasHeader**: No
- **Role**: Frequency ticket types with pricing breakdown
- **Columns**: C=区分, D=画面用名称, E=ポップアップ用名称, F=コメント, G=表示しない, H=販売額, I=券１（額）, J=券１（枚）, K=券２（額）, L=券２（枚）, M=端数額
- **Feature**: ZeroFillCols = H,I,J,K,L,M — when C column (区分) is edited and H~M are empty, they are auto-filled with "0"
#### T3 — (246)通勤_プリペイドカード名称区分一覧 (Prepaid Card Name Category)
- **HeaderRow**: 5 | **StartRow**: 7 | **StartCol**: C | **EndCol**: I
- **Encoding**: utf-8 | **HasHeader**: No
- **Role**: Prepaid card types with pricing
- **Columns**: C=区分, D=画面用名称, E=ポップアップ用名称, F=コメント, G=表示しない, H=販売額, I=利用額
### 2.4 Other / Reference Sheets
#### O1 — 住所情報 (Address Information)
- **HeaderRow**: 5 | **StartRow**: 6 | **StartCol**: C | **EndCol**: F
- **Encoding**: shift_jis | **HasHeader**: Yes
- **Role**: Employee address lookup (keyed by employee number)
- **Columns**: C=社員番号, D=更新日, E=住所１, F=住所２
#### O2 — (507)発信者一覧 (Sender List)
- **HeaderRow**: 5 | **StartRow**: 6 | **StartCol**: C | **EndCol**: O
- **Encoding**: utf-8 | **HasHeader**: No
- **Role**: Sender/official name list for dropdown (O2Cache)
- **Columns**: C=区分, D=画面用名称, E=ポップアップ用名称, F=コメント, G=表示しない, H=発信者名称, I=発信者氏名, J=所属区分（From), K=所属区分（To), L=研究科区分, M=ソート順（From), N=ソート順（To), O=諸手当認定者区分
#### O3 — (220)通勤手当届出事由区分 (Notification Reason Category)
- **HeaderRow**: 5 | **StartRow**: 6 | **StartCol**: C | **EndCol**: I
- **Encoding**: utf-8 | **HasHeader**: No
- **Role**: Notification reason categories for C1 G column dropdown (Todoke)
- **Columns**: C=区分, D=画面用名称, E=ポップアップ名称, F=コメント, G=表示しない, H=備考, I=からまで
#### Enum — Dropdown Enum Values
- **Role**: Stores all enum values used in dropdown validation
- **Sections** (each keyed by column position):
- Col A (KeyCol=1): 特別料金区分 (tokubetuList: 普通=0, 定期券=1, 回数券=2, プリペイドカード=3)
- Col C (KeyCol=3): 券種 (kenshuList)
- Col F (KeyCol=6): 連絡 (renrakuList)
- Col H (KeyCol=8): 往復区分 (oufukuList: 1=片道, 2=往復)
- Col K (KeyCol=11): 交替制 (koutaiList: 0=非該当, 1=該当)
- Col N (KeyCol=14): 非該当者認定簿出力区分 (higaitouList: 1=出力, 2=非出力)
- Col Q (KeyCol=17): エラーメッセージ (errorList)
#### Caches — Pre-rendered Dropdown Cache
- **Role**: Stores pre-built validation lists for named-range based dropdowns
- **Layout**: Each row is a pre-formatted "code:name" string used as named-range source
---
## 3. Cache Architecture
### 3.1 Cache Dictionary Keys
| Constant | Sheet | Structure | Key | Value |
|----------|-------|-----------|-----|-------|
| `CACHE_Z1` | Z1 | Dict(code → Array(name)) | transport code | Array(transport name) |
| `CACHE_Z2` | Z2 | Dict(code → Array(name)) | determination code | Array(display name) |
| `CACHE_Z3` | Z3 | Dict(code → Array(name)) | decision code | Array(display name) |
| `CACHE_Z4ROSEN` | Z4 | Dict(rosen → Dict(station → True)) | line name | Dict of all stations on that line |
| `CACHE_T1` | T1 | Dict(code → Array(name)) | ticket type code | Array(display name) |
| `CACHE_T2` | T2 | Dict(code → Array(all fields)) | ticket code | Array(C,D,E,F,G,H,I,J,K,L,M) |
| `CACHE_T3` | T3 | Dict(code → Array(all fields)) | card code | Array(C,D,E,F,G,H,I) |
| `CACHE_O1` | O1 | Dict(empNo → Array(addr1, addr2)) | employee number | Array(address1, address2) |
| `CACHE_O2` | O2 | Dict(code → Array(name)) | sender code | Array(official name) |
| `CACHE_O3` | O3 | Dict(code → Array(name)) | reason code | Array(display name) |
| `CACHE_M1` | M1 | Dict(code → Array(all cols)) | route code | Array(C,D,E,F,G,H,I,J,K,L,M,N) |
| `CACHE_M2` | M2 | Dict(code → Dict(ticketType → Array(detail))) | route code | Dict of ticket type → Array(I,J,K,L,M,N,O,P,Q,R) |
### 3.2 Special Enum Caches
| Constant | Source | Key | Value |
|----------|--------|-----|-------|
| `tokubetuList` | Enum sheet Col A | int (0-3) | name string |
| `kenshuList` | Enum sheet Col C | int | name string |
| `renrakuList` | Enum sheet Col F | int | name string |
| `oufukuList` | Enum sheet Col H | code | name string |
| `koutaiList` | Enum sheet Col K | code | name string |
| `higaitouList` | Enum sheet Col N | code | name string |
| `errorList` | Enum sheet Col Q | error code | error message |
### 3.3 m1KukanDCache (Special Derived Cache)
- **Type**: Dict(transportCode & "|" & fromStation → Dict(toStation → True))
- **Purpose**: Fast lookup of valid arrival stations given transport + departure
- **Derivation**: Built from M1 sheet at runtime: groups M1 rows by D(transport) + F(fromStation), keys are G(toStation)
- **Used by**: `BuildZ4StationToDropdown` → C1 M1 KukanD cascade
---
## 4. Module Architecture
### 4.1 Module Summary
| Module | Responsibility |
|--------|---------------|
| `Common_Constants` | Error code constants (1001-1009, 2001+) |
| `Common_Global_Cache` | All cache loading, refresh, and lookup. Sheet config definitions (RefreshSheetDict). Global Scripting.Dictionary objects. |
| `Common_Functions` | CSV helpers (GetCSVHeader, CleanCSVField), validation helpers (CheckRequired, CheckAlphanumeric, etc.), utility functions (FormatDateInput, GetCode, MakeSelect) |
| `Common_Selector` | Dropdown builder functions (BuildTransportList, BuildTodokeList, etc.) and Z4 cascade dropdowns (BuildZ4StationFromDropdown, BuildZ4StationToDropdown) |
| `Common_File_Utils` | CSV file read/write (ReadCSV, WriteCSV), BOM handling |
| `Common_Button` | Button action handlers: CSV_Import, Validation, CSV_Export, Sort, Filter, Fit. RunValidationSilent wrapper. |
| `Common_Shape` | Icon/shape alignment utilities (AlignIconsByCenter) |
### 4.2 Sheet Class Summary
| Class | Sheet | Key Methods | Notes |
|-------|-------|-------------|-------|
| `C1` | C1 | Worksheet_Change, FillAddressFromO1, FillTransportFromM1KukanD, FillDepartureFromM1KukanD, FillArrivalFromM1KukanD, FillKukanFromM1, FillCodeFromM2, ValidateRow | Main editor. No CSV import. |
| `M1` | M1 | Worksheet_Change, Validate, BuildM1StationDropdown | Route master with Z4 cascade dropdowns |
| `M2` | M2 | Worksheet_Change, Validate | Route detail master, ticket pricing |
| `T1` | T1 | Validate | Periodic pass name master |
| `T2` | T2 | Worksheet_Change, Validate | Frequency ticket master with ZeroFillCols feature |
| `T3` | T3 | Validate | Prepaid card master |
| `Z1` | Z1 | Validate | Transport type master |
| `Z2` | Z2 | Validate | Determination category master |
| `Z3` | Z3 | Validate | Monthly amount decision master |
| `Z4` | Z4 | Validate | Station name / line master |
| `O1` | O1 | Validate | Employee address master (empty stub) |
| `O2` | O2 | Validate | Sender list (empty stub) |
| `O3` | O3 | Validate | Notification reason master (empty stub) |
---
## 5. Data Flow
### 5.1 C1 Editing Flow (4 Kukan Sections)
```
User edits C (職員番号)
→ FillAddressFromO1: O1Cache lookup → populate I/J dropdowns
→ BuildTransportList → T/AB/AJ/AR dropdown (Z1Cache)
User selects T (交通機関)
→ BuildZ1StationDropdown → U/AC/AK/AS dropdown (Z1Cache)
User selects U (発)
→ BuildZ4StationFromDropdown → F column (from station) dropdown (Z4RosenCache filtered by transport)
OR: BuildM1KukanDDropdown → V/AD/AL/AT dropdown (m1KukanDCache: transport+from → to stations)
User selects S (区間コード)
→ FillKukanFromM1: M1Cache lookup → fills T/U/V/W/Y with pre-defined values
→ BuildM2Dropdown → W/AE/AM/AU dropdown (M2Cache by route code)
→ BuildM2CodeDropdown → X/AF/AN/AV dropdown (M2Cache by route+券種)
User selects W (券種)
→ BuildM2CodeDropdown → X/AF/AN/AV dropdown (M2Cache: route+券種 → code)
User edits X (コード)
→ FillCodeFromM2: M2Cache lookup → fills AF/AG/AH with M2 details
```
### 5.2 CSV Import Flow
```
CSV_Import_Button clicked
→ User selects CSV file
→ ReadCSV (Common_File_Utils): shift_jis decode, BOM strip
→ GetCSVHeader: extract header row
→ LoadLookup: build/refresh cache for target sheet
→ DO_CSV_Import: parse rows, write to sheet cells
→ RunValidationSilent: call Sheet.Validate per row
→ HandleError on validation failure
```
### 5.3 Validation Flow
```
RunValidationSilent(sheet) → for each data row
→ Sheet.Validate(ws, rowNum, lastDataRow)
→ On error: Err.Raise → caught by HandleError in caller
→ Returns error count
```
---
## 6. Key Constants
### 6.1 CACHE_ Constants (defined in Common_Global_Cache)
```
CACHE_Z4ROSEN = "Z4Rosen"
CACHE_T1 = "T1"
CACHE_T2 = "T2"
CACHE_T3 = "T3"
CACHE_O1 = "O1"
CACHE_O2 = "O2"
CACHE_O3 = "O3"
CACHE_M1 = "M1"
CACHE_M2 = "M2"
```
### 6.2 Validation Error Codes
```
1001: ERR_CACHE_NOT_FOUND
1002: ERR_CACHE_EMPTY
1003: ERR_VALIDATION_FAILED
1004: ERR_CONFIG_NOT_FOUND
1005: ERR_CONFIG_INVALID
1006: ERR_CONFIG_EMPTY_PARAM
1007: ERR_SHEET_MISSING
2001: ERR_VALIDATION
5001-5009: File/CSV errors
```
### 6.3 MakeSelect Format
All dropdown values use `code:name` format:
- Display: `"001:JR 東北線"` → MakeSelect("001", "JR 東北線")
- GetCode("001:JR 東北線") → "001"
- GetDisplay("001:JR 東北線") → "JR 東北線" (via mid/InStr)
---
## 7. Column Layout Reference
### C1 — 58 columns (C to BG)
| Column | Header | Type |
|--------|--------|------|
| C | 職員番号 | string(8) |
| D | 事実発生年月日 | date |
| E | 提出年月日 | date |
| F | 受理年月日 | date |
| G | 届出の事由コード | enum(O3) |
| H | 届出の備考 | string(40) |
| I | 住所１ | string |
| J | 住所２ | string |
| K | 運賃改正・法改正年月日 | date |
| L | 出勤予定日数 | number(2) |
| M | 往復区分 | enum(oufukuList) |
| N | 交替制 | enum(koutaiList) |
| O | 算出式 | string(80) |
| P | 自動車等使用距離 | number(3) |
| Q | 自動車等支給額 | number(6) |
| R | 自動車等駐車場代 | number(6) |
| S~Y | 区間１ (コード/交通/発/着/券種/コード/期間) | mixed |
| Z | 区間１支給開始年月 | date |
| AA~AG | 区間２ | mixed |
| AH | 区間２支給開始年月 | date |
| AI~AM | 区間３ | mixed |
| AN | 区間３支給開始年月 | date |
| AO~AS | 区間４ | mixed |
| AT | 区間４支給開始年月 | date |
| AU | 決定事項区分コード | enum(Z2) |
| AV | 非該当の理由 | string |
| AW | 非該当者認定簿出力区分 | enum(higaitouList) |
| AX | 非該当者認定簿出力区分 (actual) | enum |
| BB | 手当月額の決定区分コード | enum(Z3) |
| BC | 支給の始期 | date |
| BD | 備考 | string |
| BE | 所属コード | string |
| BF | 認定年月日 | date |
| BG | （各庁の長）官職コード | string |
---
## 8. Known Issues / Technical Debt
| # | Severity | Description | Status |
|---|----------|-------------|--------|
| 1 | High | M2.cls: `cacheVal` declared inside If block but used in Select Case outside it | Fixed |
| 2 | High | C1.cls: `kukanCol`, `kukanCode`, `kukanLetter` undeclared in Validate | Fixed |
| 3 | Medium | CJK comments in Common_Shape.bas and C1.cls | Fixed |
| 4 | Medium | Hardcoded path `D:\Project\upds7\vba\` in Import_modules.bas | Fixed |
| 5 | Medium | `sheetConfDict("Z4")` hardcoded key | Fixed |
| 6 | Medium | `sheetName:="M1"` hardcoded in Common_Shape | Fixed |
| 7 | Medium | M1.cls: `"M2"` hardcoded sheet reference | Fixed |
| 8 | Medium | `On Error Resume Next` in 3 cache lookup functions (Common_Global_Cache.bas) | Fixed |
| 9 | Low | T2.cls: CJK in comment `区分` | Fixed |
| 10 | Medium | O1/O2/O3 Validate stubs are empty | Not fixed |

194
documents/checklist-2026-05-27.md Normal file
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 过程的注释头
- [ ] 考虑分离配置管理到独立模块

184
src/sh/tuk/AUDIT_ISSUES_2026_05_28.md Normal file
View File

@@ -0,0 +1,184 @@
# tuk Project Audit Issues
Status: Open
Audit date: 2026-05-28
---
## Critical (Runtime Bugs)
### 1. M2.cls:341-356 — cacheVal used outside If block
**Severity:** 🔴 Critical
**File:** `sheet/M2.cls`
**Line:** 341-356
`cacheVal` is declared inside `If cache.Exists(code)` block but used in `Select Case` below regardless:
```vba
If cache.Exists(code) Then
Dim cacheVal As Variant: cacheVal = cache(code)
...
End If
Select Case kenshu
Case "2"
ws.Range("L" & rowNum).Value = Trim(cacheVal(1)) ' bug if code not in cache
```
Fix: move `Dim cacheVal As Variant` before the `If cache.Exists(code)` check.
---
### 2. C1.cls:984-997 — undeclared variables in Validate
**Severity:** 🔴 Critical
**File:** `sheet/C1.cls`
**Line:** 984-997
Three variables used without `Dim` in the kukan duplicate-check loop:
```vba
For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
kukanCol = KUKAN_CODE_COLS(kukanIdx) ' not declared
kukanCode = Trim(Me.Cells(rowNum, kukanCol).Value)
...
kukanLetter = Split(Me.Cells(1, kukanCol).Address, "$")(1) ' not declared
```
Fix: add `Dim kukanCol As Long, kukanCode As String, kukanLetter As String` at the top of `Validate`.
---
## AGENTS.md Violations
### 3. CJK Comments in Code
**Severity:** 🟡 AGENTS.md violation
**Files:** `module/Common_Shape.bas`, `sheet/C1.cls`
| File | Line | Content |
|------|------|---------|
| `Common_Shape.bas` | 4 | `通用排版引擎（仅调整位置）` |
| `Common_Shape.bas` | 22 | `第一个图标左边对齐B3左边` |
| `Common_Shape.bas` | 44 | `你的专属调用入口` |
| `C1.cls` | 675 | `vals(1) = D列, vals(3) = F列, vals(4) = G列` |
Fix: translate to English per AGENTS.md English-only comments rule.
---
### 4. Hardcoded File Path in Import_modules
**Severity:** 🟡 AGENTS.md violation
**File:** `init_module/Import_modules.bas`
**Line:** 8
```vba
Const PROJECT_PATH As String = "D:\Project\upds7\vba\"
```
Fix: use a config-based path or a constant defined in `Common_Constants.bas`.
---
### 5. Hardcoded Sheet Name in Z4.cls
**Severity:** 🟡 AGENTS.md violation
**File:** `sheet/Z4.cls`
**Line:** 14
```vba
Set ws = ThisWorkbook.Worksheets("Z4")
```
Fix: use `CACHE_Z4` constant instead of the string literal.
---
### 6. Hardcoded "M1" in Common_Shape
**Severity:** 🟡 AGENTS.md violation
**File:** `module/Common_Shape.bas`
**Line:** 47
```vba
sheetName:="M1"
```
Fix: pass as parameter or use constant.
---
## Code Quality
### 7. O1/O2/O3 Validate Stubs
**Severity:** 🟠 Quality
**Files:** `sheet/O1.cls`, `sheet/O2.cls`, `sheet/O3.cls`
All three have `Validate` methods that are empty stubs — just `Exit Sub`. If validation runs on these sheets, all rows pass silently.
Fix: implement proper validation or confirm empty stubs are intentional.
---
### 8. On Error Resume Next — 7 instances
**Severity:** 🟠 Quality
**Files:** `Common_Global_Cache.bas`, `Common_Functions.bas`, `Common_Shape.bas`, `Test_Cache.bas`, `Import_modules.bas`
These silently swallow errors (e.g., "subscript out of range" for missing worksheets):
| File | Line | Target |
|------|------|--------|
| `Common_Global_Cache.bas` | 91 | `ThisWorkbook.Worksheets("M1")` |
| `Common_Global_Cache.bas` | 155 | `ThisWorkbook.Worksheets("M2")` |
| `Common_Global_Cache.bas` | 232 | `ThisWorkbook.Worksheets("M1")` |
| `Common_Functions.bas` | 101 | `ThisWorkbook.Worksheets(sheetName)` |
| `Common_Shape.bas` | 14 | `ThisWorkbook.Worksheets(sheetName)` |
| `Test_Cache.bas` | 25 | `ThisWorkbook.Worksheets("Test_Cache")` |
| `Import_modules.bas` | 82, 126 | `VBProject.VBComponents` |
Fix: use `On Error GoTo ErrHandler` pattern with `Err.Raise` for missing objects, or explicitly check worksheet existence before access.
---
### 9. Fixed Cell Reference in C1 Validate
**Severity:** 🟠 Quality
**File:** `sheet/C1.cls`
**Line:** 1000
```vba
Dim linkCellValue As String: linkCellValue = Me.Cells(3, "H").Value
```
Fixed address `Cells(3, "H")` used as a config switch. No constant or comment explaining its purpose.
Fix: add a named constant or sheetConf entry for this cell.
---
## Resolved / Correct
- All modules have `Option Explicit` ✅
- All `Worksheet_Change` handlers disable `EnableEvents` and use `Finally:` pattern ✅
- All sheet classes have English module headers ✅
- T2 `FillZeroIfEmpty` uses `sheetConf("ZeroFillCols")` with letter strings ✅
- Z4 `LookupZ4RosenCache` uses F col for rosen, D col for station ✅
- `Common_Selector.BuildZ4StationToDropdown` iterates `stationFromDict.Keys` to exclude `stationFrom` ✅
- No `Select`/`Selection`/`ActiveCell` patterns in sheet classes ✅
- All `Validate` methods in Z-series and T-series have proper checkResult pattern ✅
---
## Summary
| Severity | Count |
|----------|-------|
| 🔴 Critical | 2 |
| 🟡 AGENTS.md violation | 4 |
| 🟠 Code quality | 3 |
Priority: Fix #1 → #2 → #3 → #4

59
src/sh/tuk/init_module/Import_modules.bas
View File

@@ -5,14 +5,15 @@ Sub ImportModulesAndSheets_Safe()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Const PROJECT_PATH As String = "D:\Project\upds7\vba\"
Const MODULE_PATH As String = PROJECT_PATH & "src\sh\tuk\module"
Const SHEET_PATH As String = PROJECT_PATH & "src\sh\tuk\sheet"
Dim basePath As String: basePath = ThisWorkbook.Path
If Right(basePath, 1) <> "\" Then basePath = basePath & "\"
Dim modulePath As String: modulePath = basePath & "src\sh\tuk\module"
Dim sheetPath As String: sheetPath = basePath & "src\sh\tuk\sheet"
' --- Phase 1: Validation ---
Debug.Print "[LOG] Starting validation phase..."
Dim validationErrors As String
validationErrors = ValidateAllFilesAndTargets(MODULE_PATH, SHEET_PATH)
validationErrors = ValidateAllFilesAndTargets(modulePath, sheetPath)
If validationErrors <> "" Then
MsgBox "Validation failed. Import aborted:" & vbCrLf & vbCrLf & validationErrors, vbCritical
@@ -25,8 +26,9 @@ Sub ImportModulesAndSheets_Safe()
Application.ScreenUpdating = False
Debug.Print "[LOG] Validation passed. Starting import phase..."
ImportStandardModules MODULE_PATH
ImportSheetCLSFiles SHEET_PATH
ImportStandardModules modulePath
ImportSheetCLSFiles sheetPath
ImportValidationClasses sheetPath
Application.ScreenUpdating = True
MsgBox "All .bas and .cls files imported successfully!", vbInformation
@@ -196,4 +198,45 @@ Private Function ExtractPureCodeFromCls(filePath As String) As String
ts.Close
ExtractPureCodeFromCls = result
End Function
End Function
' Import ValidationRuleEngine.cls, ValidationRule.cls, ValidationResult.cls
' as class modules (not sheet classes)
Private Sub ImportValidationClasses(sheetPath As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim valPath As String: valPath = sheetPath & "\..\validation"
Debug.Print "[LOG] Starting import of validation classes from: " & valPath
Dim classFiles As Variant
classFiles = Array("ValidationResult.cls", "ValidationRule.cls", "ValidationRuleEngine.cls")
Dim i As Long
For i = 0 To UBound(classFiles)
Dim filePath As String: filePath = valPath & "\" & classFiles(i)
If Not fso.FileExists(filePath) Then
Debug.Print "[WARNING] Validation class not found: " & filePath
Else
Dim clsName As String: clsName = fso.GetBaseName(classFiles(i))
' Remove existing class component if any
On Error Resume Next
ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(clsName)
On Error GoTo 0
DoEvents
Application.Wait Now + TimeSerial(0, 0, 1)
' Import as class module
ThisWorkbook.VBProject.VBComponents.Import filePath
DoEvents
Debug.Print "[LOG] Successfully imported validation class: " & clsName
End If
Next i
Debug.Print "[LOG] Finished importing validation classes."
End Sub

139
src/sh/tuk/module/Common_Button.bas
View File

@@ -1,55 +1,49 @@
Attribute VB_Name = "Common_Button"
Option Explicit
' --- Public Variables ---
Public lastErrorMsg As String
' --- Private Variables ---
Private m_LastErrorMsg As String
' ============================================================
' Get/Set last error message
' ============================================================
Public Sub SetLastErrorMsg(msg As String)
m_LastErrorMsg = msg
End Sub
Public Function GetLastErrorMsg() As String
GetLastErrorMsg = m_LastErrorMsg
End Function
Public Sub ClearLastErrorMsg()
m_LastErrorMsg = ""
End Sub
' ============================================================
' Module Name: Common_Button
' Module Desc: Common Button handlers with centralized error handling
' Module Methods:
' - CSV_Import_Button
' - Validation_Button
' - CSV_Export_Button
' - Sort_Button
' - Filter_Button
' Module Desc: Common button handlers with centralized error handling
' Public Methods:
' - CSV_Import_Button (CSV import entry, binds to sheet button)
' - Validation_Button (validation entry, binds to sheet button)
' - CSV_Export_Button (CSV export entry, binds to sheet button)
' - Sort_Button (sort entry, binds to sheet button)
' - Filter_Button (filter entry, binds to sheet button)
' - Fit_Button (autofit column width, binds to sheet button)
' - RefreshCache_Button (refresh master cache)
' - RunValidationSilent (validate sheet, returns row count or -1)
' - HandleError (centralized error handler)
' Private Methods:
' - ValidateKukanCache
' - UpdateByMaster
' - Fit_Button
' - RefreshCache_Button
' ============================================================
' --- Public Button Functions ---
Sub CSV_Import_Button()
DO_CSV_Import ActiveSheet
End Sub
Sub Validation_Button()
Do_Validation ActiveSheet
End Sub
Sub CSV_Export_Button()
DO_CSV_Export ActiveSheet
End Sub
Sub Sort_Button()
Do_Sort ActiveSheet
End Sub
Sub Filter_Button()
Do_Filter ActiveSheet
End Sub
Sub Fit_Button()
Do_Fit ActiveSheet
End Sub
Sub RefreshCache_Button()
On Error GoTo ErrorHandler
Dim exitMsg As String
Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName
Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O2 master data"
Dim cacheSheets As Variant: cacheSheets = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2")
Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O3 master data"
Dim cacheSheets As Variant: cacheSheets = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_Z4, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3)
Dim sheetName As Variant
Dim ws As Worksheet
For Each sheetName In cacheSheets
@@ -88,6 +82,7 @@ Sub RefreshCache_Button()
Exit Sub
ErrorHandler:
Debug.Print "sheetName = " & sheetName
HandleError "RefreshCache_Button"
End Sub
@@ -115,9 +110,10 @@ Private Sub UpdateByMaster(ByVal sheetName As String)
End Sub
' ============================================================
' CSV Import with error handler
' CSV Import entry point (binds to sheet button)
' ============================================================
Private Sub DO_CSV_Import(ws As Excel.Worksheet)
Public Sub CSV_Import_Button()
Dim ws As Worksheet: Set ws = ActiveSheet
On Error GoTo ErrorHandler
' Step 1: get csv encoding
@@ -137,9 +133,9 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet)
End If
' === Step 4: Clear all data rows before import ===
Call ClearDataRows(ws)
Application.ScreenUpdating = False
Application.EnableEvents = False
Call ClearDataRows(ws)
' === Step 5: Write CSV data to worksheet ===
Dim colLetters As Variant: colLetters = cfg("HeaderColumns")
@@ -150,6 +146,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
@@ -166,10 +165,12 @@ FinallyExit:
End Sub
' ============================================================
' Do_Validation with HandleError
' Do_Validation entry point (binds to sheet button)
' ============================================================
Private Sub Do_Validation(ws As Excel.Worksheet)
Public Sub Validation_Button()
Dim ws As Worksheet: Set ws = ActiveSheet
On Error GoTo ErrorHandler
Application.EnableEvents = False
Dim result As Long: result = RunValidationSilent(ws)
@@ -194,22 +195,22 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
Application.Run "M1.ValidateWarn", ws, lastDataRow
End If
GoTo FinallyExit
Do_Fit_Internal ws
Application.EnableEvents = True
Exit Sub
ErrorHandler:
Application.EnableEvents = True
HandleError "Do_Validation"
GoTo FinallyExit
Do_Fit_Internal ws
FinallyExit:
Do_Fit ws
ClearFormatsBelowLastDataRow ws
End Sub
' ============================================================
' CSV Export with HandleError
' CSV Export entry point (binds to sheet button)
' ============================================================
Private Sub DO_CSV_Export(ws As Excel.Worksheet)
Public Sub CSV_Export_Button()
Dim ws As Worksheet: Set ws = ActiveSheet
On Error GoTo ErrorHandler
' === Step 1: Validate all rows before export ===
@@ -281,10 +282,12 @@ ErrorHandler:
HandleError "DO_CSV_Export"
End Sub
' ============================================================
' Do_Sort with HandleError
' Do_Sort entry point (binds to sheet button)
' ============================================================
Private Sub Do_Sort(ws As Excel.Worksheet)
Public Sub Sort_Button()
Dim ws As Worksheet: Set ws = ActiveSheet
On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -300,9 +303,7 @@ Private Sub Do_Sort(ws As Excel.Worksheet)
End If
Dim sortRange As Range: Set sortRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column))
sortRange.Select
' Show sort dialog
Application.Goto sortRange
Application.Dialogs(xlDialogSort).Show
Exit Sub
@@ -310,22 +311,24 @@ ErrorHandler:
HandleError "Do_Sort"
End Sub
' ============================================================
' Do_Filter with HandleError
' Do_Filter entry point (binds to sheet button)
' ============================================================
Private Sub Do_Filter(ws As Excel.Worksheet)
Public Sub Filter_Button()
Dim ws As Worksheet: Set ws = ActiveSheet
On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' Check if auto filter is already on
If ws.AutoFilterMode Then
ws.AutoFilterMode = False
Exit Sub
End If
Dim startCol As Long: startCol = ws.Range(sheetConf("StartCol") & "1").Column
Dim startCol As Long: startCol = ws.Range(sheetConf("ErrorCol") & "1").Column
Dim endCol As Long: endCol = ws.Range(sheetConf("EndCol") & "1").Column
Dim filterRow As Long: filterRow = sheetConf("FilterRow")
@@ -338,10 +341,14 @@ ErrorHandler:
HandleError "Do_Filter"
End Sub
Public Sub Fit_Button()
Do_Fit_Internal ActiveSheet
End Sub
' ============================================================
' Do_Fit with HandleError
' Do_Fit internal implementation
' ============================================================
Private Sub Do_Fit(ws As Excel.Worksheet)
Private Sub Do_Fit_Internal(ws As Excel.Worksheet)
On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -382,10 +389,10 @@ Public Function RunValidationSilent(ws As Worksheet) As Long
Dim r As Long
Dim hasError As Boolean: hasError = False
For r = startRow To lastDataRow
lastErrorMsg = ""
Application.Run validate, ws, r, lastDataRow
If lastErrorMsg <> "" Then
Err.Raise ERR_VALIDATION_FAILED, "RunValidationSilent", lastErrorMsg
SetLastErrorMsg ""
Application.Run validate, ws, r, lastDataRow
If GetLastErrorMsg() <> "" Then
Err.Raise ERR_VALIDATION_FAILED, "RunValidationSilent", GetLastErrorMsg()
End If
Dim errorMessage As String: errorMessage = Trim(ws.Cells(r, errorCol).Value)
Dim errorCode As String: errorCode = GetCode(errorMessage)

18
src/sh/tuk/module/Common_File_Utils.bas
View File

@@ -52,8 +52,8 @@ Sub WriteCSVFromArray( _
If rows = 0 Or cols = 0 Then Exit Sub ' Empty array, exit early
' === Build CSV content ===
Dim outputLines As Collection
Set outputLines = New Collection
Dim outputLines As VBA.Collection
Set outputLines = New VBA.Collection
Dim i As Long, j As Long
Dim rowStr As String
@@ -129,8 +129,8 @@ ExitPoint:
ArrayDimensions = dimCount - 1
End Function
' Helper function: convert a Collection to a 1D array (for use with Join)
Private Function CollectionToArray(col As Collection) As Variant
' Helper function: convert a VBA.Collection to a 1D array (for use with Join)
Private Function CollectionToArray(col As VBA.Collection) As Variant
If col.Count = 0 Then
CollectionToArray = Array()
Exit Function
@@ -210,7 +210,7 @@ Function ReadCSVAs2DArrayStrict( _
textContent = Replace(textContent, vbCr, vbLf)
' === transfer into collection ===
Dim lines As Collection
Dim lines As VBA.Collection
Set lines = ParseCSVLines(textContent)
' === validate empty ===
@@ -259,14 +259,14 @@ Function ReadCSVAs2DArrayStrict( _
End Function
' Helper function: Parse CSV text into collection of string arrays (zero-based per row)
Private Function ParseCSVLines(ByVal csvText As String) As Collection
Set ParseCSVLines = New Collection
Private Function ParseCSVLines(ByVal csvText As String) As VBA.Collection
Set ParseCSVLines = New VBA.Collection
Dim length As Long: length = Len(csvText)
If length = 0 Then Exit Function
Dim i As Long: i = 1
Dim currentField As String
Dim currentRow As Collection: Set currentRow = New Collection
Dim currentRow As VBA.Collection: Set currentRow = New VBA.Collection
Dim inQuotes As Boolean
Dim c As String
@@ -314,7 +314,7 @@ Private Function ParseCSVLines(ByVal csvText As String) As Collection
Next k
End If
ParseCSVLines.Add arr
Set currentRow = New Collection
Set currentRow = New VBA.Collection
currentField = ""
inQuotes = False
i = i + 1

118
src/sh/tuk/module/Common_Functions.bas
View File

@@ -98,12 +98,9 @@ Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Obj
' --- obtain worksheet ---
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(sheetName)
On Error GoTo ErrHandler
If ws Is Nothing Then
Err.Raise ERR_SHEET_MISSING, "LoadLookup", "Worksheet '" & sheetName & "' not found."
End If
Set ws = ThisWorkbook.Worksheets(sheetName)
' ws exists, continue
Dim sheetConf As Object: Set sheetConf = sheetConfDict(cacheName)
Dim startRow As Long: startRow = sheetConf("StartRow")
@@ -221,14 +218,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)
@@ -246,7 +258,6 @@ Sub ClearDataRows(ByVal ws As Worksheet)
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
Application.EnableEvents = False
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
If lastDataRow >= startRow Then
Dim clearRange As Range
@@ -263,18 +274,16 @@ Sub ClearDataRows(ByVal ws As Worksheet)
End If
' Clear formats below lastDataRow (including dropdowns)
Application.EnableEvents = True
Call ClearFormatsBelowLastDataRow(ws)
End Sub
'Clear formats below lastDataRow
Sub ClearFormatsBelowLastDataRow(ws As Worksheet)
On Error GoTo ErrorHandler
Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As Long, endCol As Long
startCol = ws.Range(sheetConf("ErrorCol") & "1").Column
endCol = ws.Range(sheetConf("EndCol") & "1").Column
@@ -287,14 +296,9 @@ Sub ClearFormatsBelowLastDataRow(ws As Worksheet)
ws.Cells(ws.Rows.Count, endCol) _
)
Application.EnableEvents = False
clearRange.ClearContents
clearRange.Interior.Color = vbWhite
clearRange.Validation.Delete
Application.EnableEvents = True
ErrorHandler:
Application.EnableEvents = True
End Sub
' Check if text starts with prefix
@@ -327,39 +331,46 @@ End Function
Public Function FormatDateInput(ByVal inputStr As String) As String
Dim s As String: s = Trim(inputStr)
If s = "" Then Exit Function
' Only process pure digit strings
If Not IsNumeric(s) Then
FormatDateInput = inputStr
' Handle pure digit strings (YYYYMMDD / YYMMDD)
If IsNumeric(s) Then
Dim yearPart As String, monthPart As String, dayPart As String
Dim dateStr As String
If Len(s) = 8 Then
' YYYYMMDD format
yearPart = Left(s, 4)
monthPart = Mid(s, 5, 2)
dayPart = Right(s, 2)
ElseIf Len(s) = 6 Then
' YYMMDD format - add 20 prefix
yearPart = "20" & Left(s, 2)
monthPart = Mid(s, 3, 2)
dayPart = Right(s, 2)
Else
FormatDateInput = inputStr
Exit Function
End If
dateStr = yearPart & "-" & monthPart & "-" & dayPart
If IsDate(dateStr) Then
FormatDateInput = dateStr
Else
FormatDateInput = ""
End If
Exit Function
End If
Dim yearPart As String, monthPart As String, dayPart As String
Dim dateStr As String
If Len(s) = 8 Then
' YYYYMMDD format
yearPart = Left(s, 4)
monthPart = Mid(s, 5, 2)
dayPart = Right(s, 2)
ElseIf Len(s) = 6 Then
' YYMMDD format - add 20 prefix
yearPart = "20" & Left(s, 2)
monthPart = Mid(s, 3, 2)
dayPart = Right(s, 2)
Else
FormatDateInput = inputStr
' Handle non-numeric date strings (e.g. "2026/05", "2026/5/1", "2026-5-1")
If IsDate(s) Then
Dim d As Date: d = CDate(s)
FormatDateInput = Year(d) & "-" & Right("0" & Month(d), 2) & "-" & Right("0" & Day(d), 2)
Exit Function
End If
' Build date string and validate
dateStr = yearPart & "-" & monthPart & "-" & dayPart
If IsDate(dateStr) Then
FormatDateInput = dateStr
Else
FormatDateInput = inputStr
End If
' Not a date - return empty string
FormatDateInput = ""
End Function
'Check header edit protection
@@ -418,6 +429,11 @@ Function ColLetter(colNum As Long) As String
ColLetter = Split(Cells(1, colNum).Address, "$")(1)
End Function
'Convert column letter to number
Function ColNum(colLetter As String) As Long
ColNum = Range(colLetter & "1").Column
End Function
'Check required field is not empty
Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)

387
src/sh/tuk/module/Common_Global_Cache.bas
View File

@@ -8,6 +8,21 @@ Option Explicit
' - RefreshM2Cache
' - RefreshO1Cache
' ============================================================
Public Const CACHE_Z1 As String = "Z1"
Public Const CACHE_Z2 As String = "Z2"
Public Const CACHE_Z3 As String = "Z3"
Public Const CACHE_Z4 As String = "Z4"
Public Const CACHE_Z4ROSEN As String = "Z4Rosen"
Public Const CACHE_T1 As String = "T1"
Public Const CACHE_T2 As String = "T2"
Public Const CACHE_T3 As String = "T3"
Public Const CACHE_O1 As String = "O1"
Public Const CACHE_O2 As String = "O2"
Public Const CACHE_O3 As String = "O3"
Public Const CACHE_M1 As String = "M1"
Public Const CACHE_M2 As String = "M2"
Private sheetConfDict As Object
Private FormulaCache As Object
Public GlobalCache As Object
@@ -48,11 +63,13 @@ Public Sub RefreshCache(ByVal cacheName As String)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
If cacheName = "M1KukanDCache" Then
Set loadedData = LookupM1KukanCache()
ElseIf cacheName = "M2" Then
ElseIf cacheName = CACHE_M2 Then
Set loadedData = LookupM2Cache()
ElseIf cacheName = "O1" Then
Set loadedData = LookupO1Cache()
ElseIf Contains(sheetConfDict("Enum"), cacheName) Then
ElseIf cacheName = CACHE_O1 Then
Set loadedData = LookupO1Cache()
ElseIf cacheName = CACHE_Z4ROSEN Then
Set loadedData = LookupZ4RosenCache()
ElseIf Contains(sheetConfDict("Enum"), cacheName) Then
Set loadedData = LoadLookup("Enum", cacheName)
Else
Set loadedData = LoadLookup(cacheName, cacheName)
@@ -72,12 +89,9 @@ Private Function LookupM1KukanCache()
On Error GoTo ErrHandler
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("M1")
On Error GoTo ErrHandler
' ws exists, continue
Set ws = ThisWorkbook.Worksheets(CACHE_M1)
Dim sheetConf As Object: Set sheetConf = sheetConfDict("M1")
Dim sheetConf As Object: Set sheetConf = sheetConfDict(CACHE_M1)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
If lastRow < startRow Then
@@ -136,12 +150,9 @@ Private Function LookupM2Cache() As Object
On Error GoTo ErrHandler
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("M2")
On Error GoTo ErrHandler
' ws exists, continue
Set ws = ThisWorkbook.Worksheets(CACHE_M2)
Dim sheetConf As Object: Set sheetConf = sheetConfDict("M2")
Dim sheetConf As Object: Set sheetConf = sheetConfDict(CACHE_M2)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
If lastRow < startRow Then
@@ -213,12 +224,9 @@ Private Function LookupO1Cache() As Object
On Error GoTo ErrHandler
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("O1")
On Error GoTo ErrHandler
' ws exists, continue
Set ws = ThisWorkbook.Worksheets(CACHE_O1)
Dim sheetConf As Object: Set sheetConf = sheetConfDict("O1")
Dim sheetConf As Object: Set sheetConf = sheetConfDict(CACHE_O1)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
If lastRow < startRow Then
@@ -271,6 +279,63 @@ ErrHandler:
End If
End Function
' ============================================================
' Z4 Rosen Cache - nested dict for M1 E/F/H cascade dropdown
' Structure: { rosen [F]: { station [D]: True } }
' ============================================================
Private Function LookupZ4RosenCache() As Object
Dim resultCache As Object
Set resultCache = CreateObject("Scripting.Dictionary")
resultCache.CompareMode = vbTextCompare
On Error GoTo ErrHandler
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CACHE_Z4)
Dim sheetConf As Object: Set sheetConf = GetSheetConfig()(CACHE_Z4)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
If lastRow < startRow Then
Set LookupZ4RosenCache = resultCache
Exit Function
End If
Dim r As Long
Dim station As String
Dim rosen As String
Dim innerDict As Object
For r = startRow To lastRow
rosen = Trim(ws.Cells(r, 6).Value)
station = Trim(ws.Cells(r, 4).Value)
If rosen = "" Or station = "" Then GoTo NextRow3
If Not resultCache.Exists(rosen) Then
Set innerDict = CreateObject("Scripting.Dictionary")
innerDict.CompareMode = vbTextCompare
resultCache.Add rosen, innerDict
End If
Set innerDict = resultCache(rosen)
If Not innerDict.Exists(station) Then
innerDict.Add station, True
End If
NextRow3:
Next r
Set LookupZ4RosenCache = resultCache
Exit Function
ErrHandler:
If Err.Number = 9 Then
Err.Raise ERR_SHEET_MISSING, "LookupZ4RosenCache", "Sheet 'Z4' not found."
Else
Err.Raise ERR_CACHE_NOT_FOUND, "LookupZ4RosenCache", "Failed to load Z4Rosen cache: " & Err.Description
End If
End Function
Private Sub RefreshSheetDict()
Debug.Print "RefreshSheetDict begin."
Set sheetConfDict = CreateObject("Scripting.Dictionary")
@@ -308,7 +373,7 @@ Private Sub RefreshSheetDict()
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(3, 4, 5, 6, 7, 9, 12)
Set sheetConfDict("M1") = sheetConf
Set sheetConfDict(CACHE_M1) = sheetConf
Debug.Print "RefreshSheetDict M1 ok."
' M2
@@ -324,50 +389,72 @@ Private Sub RefreshSheetDict()
sheetConf("HeaderColumns") = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R")
sheetConf("AlwaysQuote") = False
sheetConf("FilterRow") = 7
Set sheetConfDict("M2") = sheetConf
Set sheetConfDict(CACHE_M2) = sheetConf
Debug.Print "RefreshSheetDict M2 ok."
' Z1
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "I"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict("Z1") = sheetConf
Debug.Print "RefreshSheetDict Z1 ok."
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "I"
sheetConf("ErrorCol") = "B"
sheetConf("DisplayCol") = "H"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict(CACHE_Z1) = sheetConf
Debug.Print "RefreshSheetDict Z1 ok."
' Z2
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "G"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 5
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict("Z2") = sheetConf
Debug.Print "RefreshSheetDict Z2 ok."
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "G"
sheetConf("ErrorCol") = "B"
sheetConf("DisplayCol") = "G"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 5
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict(CACHE_Z2) = sheetConf
Debug.Print "RefreshSheetDict Z2 ok."
' Z3
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "H"
sheetConf("ErrorCol") = "B"
sheetConf("DisplayCol") = "G"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 6
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict(CACHE_Z3) = sheetConf
Debug.Print "RefreshSheetDict Z3 ok."
' Z4
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "H"
sheetConf("ErrorCol") = "B"
sheetConf("DisplayCol") = "H"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
@@ -378,80 +465,66 @@ Private Sub RefreshSheetDict()
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict("Z3") = sheetConf
Debug.Print "RefreshSheetDict Z3 ok."
' Z4
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "I"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict("Z4") = sheetConf
Set sheetConfDict(CACHE_Z4) = sheetConf
Debug.Print "RefreshSheetDict Z4 ok."
' T1
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "G"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 5
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict("T1") = sheetConf
Debug.Print "RefreshSheetDict T1 ok."
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "G"
sheetConf("ErrorCol") = "B"
sheetConf("DisplayCol") = "G"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 5
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict(CACHE_T1) = sheetConf
Debug.Print "RefreshSheetDict T1 ok."
' T2
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "M"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 11
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4, 8, 9, 10, 11, 12, 13)
Set sheetConfDict("T2") = sheetConf
Debug.Print "RefreshSheetDict T2 ok."
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "M"
sheetConf("ErrorCol") = "B"
sheetConf("DisplayCol") = "G"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 11
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4, 8, 9, 10, 11, 12, 13)
sheetConf("ZeroFillCols") = Array("H", "I", "J", "K", "L", "M")
Set sheetConfDict(CACHE_T2) = sheetConf
Debug.Print "RefreshSheetDict T2 ok."
' T3
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "I"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4, 8, 9)
Set sheetConfDict("T3") = sheetConf
Debug.Print "RefreshSheetDict T3 ok."
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "I"
sheetConf("ErrorCol") = "B"
sheetConf("DisplayCol") = "G"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4, 8, 9)
Set sheetConfDict(CACHE_T3) = sheetConf
Debug.Print "RefreshSheetDict T3 ok."
' O1
Set sheetConf = CreateObject("Scripting.Dictionary")
@@ -466,7 +539,7 @@ Private Sub RefreshSheetDict()
sheetConf("HeaderColumns") = Array("C", "D", "E", "F")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 5
Set sheetConfDict("O1") = sheetConf
Set sheetConfDict(CACHE_O1) = sheetConf
Debug.Print "RefreshSheetDict O1 ok."
' O2
@@ -484,9 +557,27 @@ Private Sub RefreshSheetDict()
sheetConf("FilterRow") = 5
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict("O2") = sheetConf
Set sheetConfDict(CACHE_O2) = sheetConf
Debug.Print "RefreshSheetDict O2 ok."
' O3
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "I"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 6
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 5
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict(CACHE_O3) = sheetConf
Debug.Print "RefreshSheetDict O3 ok."
' Enum
Set sheetConf = Nothing
sheetConfDict("Enum") = Array("tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
@@ -558,15 +649,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("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2", _
"tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
fixedCaches = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_Z4, CACHE_Z4ROSEN, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3)
' Refresh fixed caches
Dim cacheName As Variant
@@ -574,17 +677,20 @@ Public Sub RefreshMasterCache()
Call RefreshCache(CStr(cacheName))
Call WriteCachesSheet(CStr(cacheName))
Next cacheName
Call RefreshEnumCache
End Sub
Public Sub RefreshKukanCache(ByVal sheetName As String)
If sheetName = "M1" Then
Call RefreshCache("M1")
If sheetName = CACHE_M1 Then
Call RefreshCache(CACHE_M1)
Call RefreshCache("M1KukanDCache")
Call WriteCachesSheet("M1")
Call RefreshCache(CACHE_Z4ROSEN)
Call WriteCachesSheet(CACHE_M1)
End If
If sheetName = "M2" Then
Call RefreshCache("M2")
Call WriteCachesSheet("M2")
If sheetName = CACHE_M2 Then
Call RefreshCache(CACHE_M2)
Call WriteCachesSheet(CACHE_M2)
End If
End Sub
@@ -601,15 +707,16 @@ Public Sub WriteCachesSheet(ByVal cacheName As String)
' Map cacheName to column letter
Dim colLetter As String
Select Case cacheName
Case "Z1": colLetter = "A"
Case "Z2": colLetter = "B"
Case "Z3": colLetter = "C"
Case "Z4": colLetter = "D"
Case "T1": colLetter = "E"
Case "T2": colLetter = "F"
Case "T3": colLetter = "G"
Case "O2": colLetter = "H"
Case "M1": colLetter = "I"
Case CACHE_Z1: colLetter = "A"
Case CACHE_Z2: colLetter = "B"
Case CACHE_Z3: colLetter = "C"
Case CACHE_Z4: colLetter = "D"
Case CACHE_T1: colLetter = "E"
Case CACHE_T2: colLetter = "F"
Case CACHE_T3: colLetter = "G"
Case CACHE_O2: colLetter = "H"
Case CACHE_O3: colLetter = "I"
Case CACHE_M1: colLetter = "M"
Case Else: Exit Sub
End Select

108
src/sh/tuk/module/Common_Selector.bas
View File

@@ -19,7 +19,7 @@ Option Explicit
' ============================================================
' Create Transport (T) dropdown from Z1 cache
Public Function BuildTransportList()
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
Dim dropdownList As String
Dim key As Variant
@@ -38,13 +38,13 @@ End Function
' Create Todoke (G) dropdown
Public Function BuildTodokeList()
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3)
Dim dropdownList As String
Dim key As Variant
For Each key In z4Cache.Keys
For Each key In o3Cache.Keys
Dim displayText As String
displayText = MakeSelect(key, z4Cache(key)(0))
displayText = MakeSelect(key, o3Cache(key)(0))
If dropdownList = "" Then
dropdownList = displayText
Else
@@ -92,7 +92,7 @@ End Function
' Create Kettei (AU) dropdown
Public Function BuildKetteiList()
Dim z2Cache As Object: Set z2Cache = GetCache("Z2")
Dim z2Cache As Object: Set z2Cache = GetCache(CACHE_Z2)
Dim dropdownList As String
Dim key As Variant
@@ -128,7 +128,7 @@ End Function
' Create Kanshoku (BC) dropdown
Public Function BuildKanshokuList()
Dim o2Cache As Object: Set o2Cache = GetCache("O2")
Dim o2Cache As Object: Set o2Cache = GetCache(CACHE_O2)
Dim dropdownList As String
Dim key As Variant
@@ -218,6 +218,102 @@ Public Sub BuildRenrakuDropdown(ws As Worksheet, ByVal columnLetter As String, B
End With
End Sub
' ============================================================
' Z4 Rosen Dropdown Builders for M1 E/F/H cascade
' ============================================================
' Build F column (station from) dropdown based on E column (rosen name)
Public Sub BuildZ4StationFromDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long, ByVal rosen As String)
Dim z4RosenCache As Object: Set z4RosenCache = GetCache(CACHE_Z4ROSEN)
ws.Range(columnLetter & rowNum).Validation.Delete
If rosen = "" Then Exit Sub
If Not z4RosenCache.Exists(rosen) Then Exit Sub
Dim stationFromDict As Object: Set stationFromDict = z4RosenCache(rosen)
Dim dropdownList As String: dropdownList = ""
Dim stationFrom As Variant
For Each stationFrom In stationFromDict.Keys
If dropdownList = "" Then
dropdownList = stationFrom
Else
dropdownList = dropdownList & "," & stationFrom
End If
Next stationFrom
If dropdownList = "" Then Exit Sub
With ws.Range(columnLetter & rowNum).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
End With
End Sub
' Build H column (station to) dropdown based on E column (rosen name) and F column (station from)
Public Sub BuildZ4StationToDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long, ByVal rosen As String, ByVal stationFrom As String)
Dim z4RosenCache As Object: Set z4RosenCache = GetCache(CACHE_Z4ROSEN)
ws.Range(columnLetter & rowNum).Validation.Delete
If rosen = "" Or stationFrom = "" Then Exit Sub
If Not z4RosenCache.Exists(rosen) Then Exit Sub
Dim stationFromDict As Object: Set stationFromDict = z4RosenCache(rosen)
Dim dropdownList As String: dropdownList = ""
Dim s As Variant
For Each s In stationFromDict.Keys
If s <> stationFrom Then
If dropdownList = "" Then
dropdownList = s
Else
dropdownList = dropdownList & "," & s
End If
End If
Next s
If dropdownList = "" Then Exit Sub
With ws.Range(columnLetter & rowNum).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
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)

19
src/sh/tuk/module/Common_Shape.bas
View File

@@ -1,7 +1,7 @@
Attribute VB_Name = "Common_Shape"
Option Explicit
' ================= 通用排版引擎（仅调整位置） =================
' ================= Common Layout Engine (position only) =================
Public Sub AlignIconsByCenter(sheetName As String, anchorAddr As String, _
iconArr As Variant, gapPt As Double)
@@ -10,16 +10,14 @@ Public Sub AlignIconsByCenter(sheetName As String, anchorAddr As String, _
Dim shp As Shape
Dim i As Long
Dim shapeCount As Long
On Error Resume Next
On Error GoTo ErrHandler
Set ws = ThisWorkbook.Worksheets(sheetName)
On Error GoTo 0
If ws Is Nothing Then Exit Sub
' ws exists, continue
Set anchor = ws.Range(anchorAddr)
shapeCount = UBound(iconArr) - LBound(iconArr) + 1
' 第一个图标左边对齐B3左边
' First icon left-aligns to B3 left edge
Dim curX As Double: curX = anchor.Left
Dim prevX As Double: prevX = 0
Dim cy As Double: cy = anchor.Top + anchor.Height / 2
@@ -39,12 +37,17 @@ Public Sub AlignIconsByCenter(sheetName As String, anchorAddr As String, _
curX = curX + shp.Width + gapPt
Next i
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "AlignIconsByCenter"
Application.ScreenUpdating = True
End Sub
' ================= 你的专属调用入口 =================
' ================= Entry point =================
Sub RunAlignForMySheet()
AlignIconsByCenter _
sheetName:="M1", _
sheetName:=CACHE_M1, _
anchorAddr:="B3", _
iconArr:=Array("input", "check", "output", "sort", "filter", "fit", "load"), _
gapPt:=10

17
src/sh/tuk/module/ValidationRuleEnums.bas Normal file
View File

@@ -0,0 +1,17 @@
Attribute VB_Name = "ValidationRuleEnums"
' ValidationRuleEnums.bas
' Standard module for shared rule-type constants.
' Using Long constants instead of Enum to avoid VBA class-module ambiguity issues.
Option Explicit
Public Const ValRule_Required As Long = 0
Public Const ValRule_Date As Long = 1
Public Const ValRule_Number As Long = 2
Public Const ValRule_CodeSelect As Long = 3
Public Const ValRule_Range As Long = 4
Public Const ValRule_Duplicate As Long = 5
Public Const ValRule_Char As Long = 6
Public Const ValRule_Varchar As Long = 7
Public Const ValRule_Check01 As Long = 8
Public Const ValRule_Alphanumeric As Long = 9
Public Const ValRule_Custom As Long = 11

66
src/sh/tuk/sheet/C1.cls
View File

@@ -109,7 +109,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
' Check if cache is loaded
Application.EnableEvents = False
On Error GoTo Finally
Dim testCache As Object: Set testCache = GetCache("Z1")
Dim testCache As Object: Set testCache = GetCache(CACHE_Z1)
' === Column C changes ===
If Target.Column = 3 Then
@@ -135,11 +135,11 @@ Private Sub Worksheet_Change(ByVal Target As Range)
For Each cellG In Target
Dim todoke As String: todoke = Trim(cellG.Value)
If todoke <> "" Then
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3)
Dim todokeCde As String: todokeCde = GetCode(todoke)
If z4Cache.Exists(todokeCde) Then
If o3Cache.Exists(todokeCde) Then
Dim cellH As Range: Set cellH = Me.Cells(cellG.Row, 8)
cellH.Value = z4Cache(todokeCde)(0)
cellH.Value = o3Cache(todokeCde)(0)
End If
End If
Next
@@ -157,14 +157,21 @@ Private Sub Worksheet_Change(ByVal Target As Range)
idx = GetIdx(Target.Column, DATE_COLS)
If idx >= 0 Then
Dim cellDate As Range
Dim formattedDate As String
For Each cellDate In Target
If Trim(cellDate.Value) <> "" Then
Dim formattedDate As String: formattedDate = FormatDateInput(cellDate.Value)
cellDate.Value = FormatDateInput(formattedDate)
If cellDate.Column = 5 Then
Dim fCell As Range: Set fCell = Me.Cells(cellDate.Row, 6)
If Trim(fCell.Value) = "" Then
fCell.Value = formattedDate
formattedDate = FormatDateInput(cellDate.Value)
If formattedDate = "" Then
' Invalid date input - clear cell and show message
cellDate.Value = ""
MsgBox "Please enter a valid date (YYYY-MM-DD or YYYY/MM/DD)", vbExclamation, "Invalid Date"
Else
cellDate.Value = formattedDate
If cellDate.Column = 5 Then
Dim fCell As Range: Set fCell = Me.Cells(cellDate.Row, 6)
If Trim(fCell.Value) = "" Then
fCell.Value = formattedDate
End If
End If
End If
End If
@@ -272,7 +279,7 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End Sub
Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
Application.EnableEvents = False
On Error GoTo ErrorHandler
@@ -336,13 +343,13 @@ Private Sub RebuildDropdowns(ByVal rowNum As Long)
End With
Next i
Call BuildDropdownFromCacheNamedRange(Me, MMONTH_AMOUNT_KBN_COL, rowNum, "Z3")
Call BuildDropdownFromCacheNamedRange(Me, MMONTH_AMOUNT_KBN_COL, rowNum, CACHE_Z3)
End Sub
Private Sub ReFillFromDropdowns(ByVal rowNum As Long)
Dim z3Cache As Object: Set z3Cache = GetCache("Z3")
Dim z3Cache As Object: Set z3Cache = GetCache(CACHE_Z3)
Dim valueStrMonthAmountKbn As String: valueStrMonthAmountKbn = Trim(Me.Cells(rowNum, MMONTH_AMOUNT_KBN_COL).Value)
Dim monthAmountKbn As String: monthAmountKbn = GetCode(valueStrMonthAmountKbn)
If z3Cache.Exists(monthAmountKbn) Then
@@ -430,7 +437,7 @@ End Sub
' when cshainno does not exist in o1, clear dropdownList and value
' when cshainno exist in o1, create dropdownList and value
Private Sub BuildAddress1Dropdown(ByVal rowNum As Long, ByVal cshainno As String)
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
' Build dropdown list from O1 cache: get all E values for the C
Dim dropdownList As String
If o1Cache.Exists(cshainno) Then
@@ -460,7 +467,7 @@ Private Sub BuildAddress1Dropdown(ByVal rowNum As Long, ByVal cshainno As String
End Sub
Private Sub ReFillAddress1(ByVal rowNum As Long, ByVal cshainno As String)
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
If Not o1Cache.Exists(cshainno) Then
Me.Cells(rowNum, ADDRESS1_COL).Value = ""
Exit Sub
@@ -487,7 +494,7 @@ End Sub
Private Sub BuildAddress2Dropdown(ByVal rowNum As Long, ByVal cshainno As String)
' Clear address2 contents
' obtain cshainno, address1, o1Cache
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value)
If cshainno = "" OR address1 = "" Then
Exit Sub
@@ -534,7 +541,7 @@ Private Sub ReFillAddress2(ByVal rowNum As Long, ByVal cshainno As String)
Exit Sub
End If
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
If Not o1Cache.Exists(cshainno) Then
Me.Cells(rowNum, ADDRESS2_COL).Value = ""
Exit Sub
@@ -672,7 +679,7 @@ Private Function FindKukanCodeByStation(ByVal rowNum As Long, ByVal transportCol
Dim code As Variant
For Each code In m1Cache.Keys
Dim vals As Variant: vals = m1Cache(code)
' vals(1) = D列, vals(3) = F列, vals(4) = G列
' vals(1) = D col, vals(3) = F col, vals(4) = G col
If vals(1) = transportKbn And vals(3) = stationFrom And vals(4) = stationTo Then
FindKukanCodeByStation = code
Exit Function
@@ -791,15 +798,18 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
Next col
' validate date
' validate date
Dim colIndex As Variant
For Each colIndex In DATE_COLS()
Dim cellDate As String: cellDate = Trim(Me.Cells(rowNum, colIndex).Value)
If cellDate <> "" And Not IsDate(cellDate) Then
Dim letter As String: letter = Split(Me.Cells(1, colIndex).Address, "$")(1)
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum)
Me.Range(letter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
If cellDate <> "" Then
' Require full YYYY-MM-DD format (output of FormatDateInput)
If Len(cellDate) <> 10 Or Mid(cellDate, 5, 1) <> "-" Or Mid(cellDate, 8, 1) <> "-" Then
Dim letter As String: letter = Split(Me.Cells(1, colIndex).Address, "$")(1)
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum)
Me.Range(letter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
Next colIndex
@@ -816,16 +826,16 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' validate CodeSelect
' G column [todoke Cde]
Dim ColG As String: ColG = "G"
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3)
Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value))
If Not z4Cache.Exists(todokeCde) Then
If Not o3Cache.Exists(todokeCde) Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColG & rowNum)
Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' I column [address1 J column address2]
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim o1Cache As Object: Set o1Cache = GetCache(CACHE_O1)
Dim ColI As String: ColI = "I"
Dim ColJ As String: ColJ = "J"
Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ColI).Value)
@@ -1033,7 +1043,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
SetLastErrorMsg Err.Description
End Sub
' Create teiki dropdown based on M2 cache

232
src/sh/tuk/sheet/M1.cls
View File

@@ -11,16 +11,18 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
' Multi-cell selection not processed
If Target.Count > 1 Then Exit Sub
If Target.Count > 1 Then 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
Me.Cells(cell.Row, 12).Validation.Delete
Call ClearDataRow(Me, START_COL + 1, END_COL, cell.Row, ERROR_COL)
Call ClearDataRow(Me, cell.Row)
Else
Call BuildTokubetuDropdown(Me, "L", cell.Row)
Call BuildRenrakuDropdown(Me, "K", cell.Row)
@@ -30,23 +32,81 @@ Private Sub Worksheet_Change(ByVal Target As Range)
' === Column D changes: Fill E column ===
If Target.Column = 4 And Target.Row >= 7 Then
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
Dim z4Rosen As Object: Set z4Rosen = GetCache(CACHE_Z4ROSEN)
Dim cellD As Range
For Each cellD In Target
Dim dVal As String: dVal = Trim(cellD.Value)
If dVal = "" Then
Me.Cells(cellD.Row, 5).ClearContents
Me.Cells(cellD.Row, 6).ClearContents
Me.Cells(cellD.Row, 7).ClearContents
Me.Cells(cellD.Row, 6).Validation.Delete
Me.Cells(cellD.Row, 7).Validation.Delete
Else
If Not z1Cache Is Nothing And z1Cache.Exists(dVal) Then
Dim valsD As Variant: valsD = z1Cache(dVal)
Me.Cells(cellD.Row, 5).Value = valsD(0)
If z1Cache.Exists(dVal) Then
Dim kikan As Variant: kikan = z1Cache(dVal)
Dim kikanName As String: kikanName = kikan(0)
Me.Cells(cellD.Row, 5).Value = kikanName
If z4Rosen.Exists(kikanName) Then
Call BuildZ4StationFromDropdown(Me, "F", cellD.Row, kikanName)
Dim stations As Object: Set stations = z4Rosen(kikanName)
Dim fromCell As Range: Set fromCell = Me.Cells(cellD.Row, 6)
Dim fromStation As String: fromStation = Trim(fromCell.Value)
If Not stations.Exists(fromStation) Or fromStation = "" Then
fromCell.ClearContents
Me.Cells(cellD.Row, 7).ClearContents
Me.Cells(cellD.Row, 7).Validation.Delete
Else
Call BuildZ4StationToDropdown(Me, "G", cellD.Row, kikanName, fromStation)
Dim toCell As Range: Set toCell = Me.Cells(cellD.Row, 7)
Dim toStation As String: toStation = Trim(toCell.Value)
If Not stations.Exists(toStation) Or toStation = "" Then
toCell.ClearContents
End If
End If
Else
Me.Cells(cellD.Row, 6).ClearContents
Me.Cells(cellD.Row, 7).ClearContents
Me.Cells(cellD.Row, 6).Validation.Delete
Me.Cells(cellD.Row, 7).Validation.Delete
End If
Else
Me.Cells(cellD.Row, 5).ClearContents
Me.Cells(cellD.Row, 6).ClearContents
Me.Cells(cellD.Row, 7).ClearContents
Me.Cells(cellD.Row, 6).Validation.Delete
Me.Cells(cellD.Row, 7).Validation.Delete
End If
End If
Next
End If
' === Column F changes (station from): Build H column (station to) dropdown ===
If Target.Column = 6 And Target.Row >= 7 Then
Dim cellF As Range
For Each cellF In Target
Dim stationFrom As String: stationFrom = Trim(cellF.Value)
Dim rosenForH As String: rosenForH = Trim(Me.Cells(cellF.Row, 5).Value)
If stationFrom = "" Then
Me.Cells(cellF.Row, 7).ClearContents
Me.Cells(cellF.Row, 7).Validation.Delete
Else
Call BuildZ4StationToDropdown(Me, "G", cellF.Row, rosenForH, stationFrom)
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
@@ -61,113 +121,105 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End If
End Sub
Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
With engine
.AddRequired "C"
.AddChar "C", 5
.AddAlphanumeric "C"
.AddDuplicate "C"
.AddRequired "D"
.AddCodeSelect "D", CACHE_Z1
.AddRequired "E"
.AddCodeSelect "E", CACHE_Z4ROSEN
.AddRequired "F"
.AddRequired "G"
.AddRequired "I"
.AddRequired "L"
.AddCodeSelect "K", "renrakuList"
.AddCodeSelect "L", "tokubetuList"
.AddNumber "H", 6, 1
.AddNumber "I", 5
.AddNumber "J", 6
.AddNumber "N"
End With
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim result As ValidationResult: Set result = engine.ValidateRow(ws, rowNum, lastDataRow)
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
' === Special cases (cross-column / cross-cache) ===
If result.ErrorCode = "" Then
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
' Check column required
Dim colLetter As Variant
For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L")
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
errorCell.Value = GetErrorMsg("E002", colLetter & rowNum)
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next colLetter
' Check column numeric
For Each colLetter In Array("H", "I", "J", "N")
Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value)
If val <> "" And Not IsNumeric(val) Then
errorCell.Value = GetErrorMsg("E011", colLetter & rowNum)
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next colLetter
' Check C column repeat
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
Dim foundCell As Range
Set foundCell = ws.Range("C7:C" & lastDataRow).Find(What:=cValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not foundCell Is Nothing Then
If foundCell.Row <> rowNum Then
errorCell.Value = "C column value is duplicated"
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
' Check D and E column in the cache
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
If Not z1Cache.Exists(dValue) Then
errorCell.Value = GetErrorMsg("E004", "D" & rowNum)
ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
Else
Dim valueArray As Variant
valueArray = z1Cache(dValue)
If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then
errorCell.Value = "Invalid reference data for D column."
Exit Sub
End If
Dim expectedEValue As String
expectedEValue = Trim(CStr(valueArray(0)))
If eValue <> expectedEValue Then
errorCell.Value = "E column does not match reference data."
' E: must equal CACHE_Z1(D) value
Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
Dim valArray As Variant: valArray = z1Cache(dValue)
Dim expectedE As String: expectedE = Trim(CStr(valArray(0)))
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
If eValue <> expectedE Then
errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "E" & CStr(rowNum))
ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' F, G: must be valid stations in the rosen (E), F cannot equal G
Dim z4Rosen As Object: Set z4Rosen = GetCache(CACHE_Z4ROSEN)
Dim stations As Object: Set stations = z4Rosen(eValue)
Dim fValue As String: fValue = Trim(ws.Range("F" & rowNum).Value)
Dim gValue As String: gValue = Trim(ws.Range("G" & rowNum).Value)
If Not stations.Exists(fValue) Then
errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "F" & CStr(rowNum))
ws.Range("F" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Not stations.Exists(gValue) Then
errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "G" & CStr(rowNum))
ws.Range("G" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If fValue = gValue Then
errorCell.Value = GetErrorMsg(ERR_INVALID, "G" & CStr(rowNum))
ws.Range("F" & rowNum).Interior.Color = RGB(255, 0, 0)
ws.Range("G" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
' Check L column in the tokubetuList
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
If Not tokubetuList.Exists(lValue) Then
errorCell.Value = "L column does not exist."
ws.Range("L" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' Validation passed - clear error
If Not StartsWith(errorCell.Value, "W") Then
errorCell.ClearContents
End If
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
SetLastErrorMsg Err.Description
End Sub
' obtain z1 master data, and update column E
Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
Application.EnableEvents = False
On Error GoTo ErrorHandler
Dim r As Long
Dim z4Rosen As Object: Set z4Rosen = GetCache(CACHE_Z4ROSEN)
For r = startRow To lastDataRow
Dim dVal As String: dVal = Trim(ws.Cells(r, 4).Value) ' Column D
If dVal <> "" And z1Cache.Exists(dVal) Then
Dim valsD As Variant: valsD = z1Cache(dVal)
ws.Cells(r, 5).Value = valsD(0) ' Column E
Dim kikanName As String: kikanName = valsD(0)
If z4Rosen.Exists(kikanName) Then
Call BuildZ4StationFromDropdown(ws, "F", r, kikanName)
Dim stationFrom As String: stationFrom = Trim(ws.Cells(r, 6).Value)
If stationFrom <> "" Then
Call BuildZ4StationToDropdown(ws, "G", r, kikanName, stationFrom)
End If
End If
End If
Call BuildTokubetuDropdown(ws, "L", r)
Call BuildRenrakuDropdown(ws, "K", r)
@@ -187,9 +239,9 @@ Private Sub ValidateWarn(ws As Worksheet, ByVal lastDataRow As Long)
' Get M2 sheet kukan code list directly
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim m2SheetConf As Object: Set m2SheetConf = sheetConfDict("M2")
Dim m2SheetConf As Object: Set m2SheetConf = sheetConfDict(CACHE_M2)
Dim m2StartRow As Long: m2StartRow = m2SheetConf("StartRow")
Dim wsM2 As Worksheet: Set wsM2 = ThisWorkbook.Worksheets("M2")
Dim wsM2 As Worksheet: Set wsM2 = ThisWorkbook.Worksheets(CACHE_M2)
Dim lastRowM2 As Long: lastRowM2 = GetLastDataRowInRange(wsM2)
If lastRowM2 < m2StartRow Then
exitMsg = "M2 sheet has no data"

265
src/sh/tuk/sheet/M2.cls
View File

@@ -108,163 +108,142 @@ End Sub
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
With engine
.AddRequired "C"
.AddDuplicate "C"
.AddCodeSelect "C", CACHE_M1
.AddRequired "I"
.AddRequired "J"
.AddRequired "K"
.AddRequired "L"
.AddRequired "M"
.AddNumber "L"
.AddNumber "M"
.AddNumber "N"
.AddNumber "O"
.AddNumber "P"
.AddNumber "Q"
.AddNumber "R"
End With
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim result As ValidationResult: Set result = engine.ValidateRow(ws, rowNum, lastDataRow)
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
' === Special cases (cross-cache / cross-column) ===
If result.ErrorCode = "" Then
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
' Check C column in the cache
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
' J: must exist in T1/T2/T3 cache (determined by I column)
Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value)
Dim cache As Object
Select Case kenshuKbn
Case "1": Set cache = GetCache(CACHE_T1)
Case "2": Set cache = GetCache(CACHE_T2)
Case "3": Set cache = GetCache(CACHE_T3)
Case Else
errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "I" & rowNum)
ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End Select
' C column check
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
If Not m1Cache.Exists(cValue) Then
errorCell.Value = GetErrorMsg("E004", "C" & rowNum)
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' Check column required
Dim colLetter As Variant
For Each colLetter In Array("I", "J", "K", "L", "M")
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
errorCell.Value = GetErrorMsg("E002", colLetter & rowNum)
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Dim code As String: code = Trim(ws.Range("J" & rowNum).Value)
If Not cache.Exists(code) Then
errorCell.Value = GetErrorMsg(ERR_NOT_EXIST, "J" & rowNum)
ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next colLetter
' Check column numeric (only if has value)
Dim numericCols As Variant: numericCols = Array("L", "M", "N", "O", "P", "Q", "R")
Dim col As Variant
For Each col In numericCols
Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "")
If val <> "" And Not IsNumeric(val) Then
errorCell.Value = GetErrorMsg("E011", col & rowNum)
ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next col
Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value)
Dim cache As Object
Dim requiredCols As Variant
Dim equaledCols As Variant
Dim emptyCols As Variant
If kenshuKbn = "1" Then
Set cache = GetCache("T1")
' must input
equaledCols = Array("K")
requiredCols = Array("N")
emptyCols = Array("O", "P", "Q", "R")
End If
If kenshuKbn = "2" Then
Set cache = GetCache("T2")
' must input
equaledCols = Array("K", "L", "M", "N", "O", "P", "Q")
requiredCols = Array("N", "O", "P", "Q")
emptyCols = Array("R")
End If
If kenshuKbn = "3" Then
Set cache = GetCache("T3")
' must input
equaledCols = Array("K", "L", "M")
requiredCols = Array()
emptyCols = Array("N", "O", "P", "Q", "R")
End If
' Check J column in the T1, T2, T3
' code not exist check
Dim code As String: code = Trim(ws.Range("J" & rowNum).Value)
If Not cache.Exists(code) Then
errorCell.Value = GetErrorMsg("E004", "J" & rowNum)
ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim equaledCol As Variant
Dim equaledIndex As Long
For equaledIndex = LBound(equaledCols) To UBound(equaledCols)
equaledCol = equaledCols(equaledIndex)
' M2 value
Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value)
If cache(code)(equaledIndex) <> equalValue Then
errorCell.Value = GetErrorMsg("E004", equaledCol & rowNum)
ws.Range(equaledCol & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next equaledIndex
Dim requiredCol As Variant
For Each requiredCol In requiredCols
Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value)
If requiredValue = "" Then
errorCell.Value = GetErrorMsg("E002", requiredCol & rowNum)
ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next requiredCol
Dim emptyCol As Variant
For Each emptyCol In emptyCols
Dim emptyValue As String: emptyValue = Trim(ws.Range(emptyCol & rowNum).Value)
If emptyValue <> "" Then
errorCell.Value = GetErrorMsg("E005", emptyCol & rowNum)
ws.Range(emptyCol & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next emptyCol
' check Duplicate
Dim sikyuKikan As String: sikyuKikan = Trim(ws.Range("N" & rowNum).Value)
Dim hasError As Boolean: hasError = False
Dim otherValueC As String, otherValueI As String, otherValueJ As String, otherValueN As String
Dim otherRow As Long
For otherRow = 7 To rowNum - 1
otherValueC = Trim(ws.Cells(otherRow, "C").Value)
otherValueI = Trim(ws.Cells(otherRow, "I").Value)
otherValueJ = Trim(ws.Cells(otherRow, "J").Value)
otherValueN = Trim(ws.Cells(otherRow, "N").Value)
' kenshuKbn-specific: equaledCols, requiredCols, emptyCols
Dim equaledCols As Variant
Dim requiredCols As Variant
Dim emptyCols As Variant
If kenshuKbn = "1" Then
If otherValueC = cValue And otherValueI = kenshuKbn And otherValueJ = code And otherValueN = sikyuKikan Then
hasError = True
End If
Else
If otherValueC = cValue And otherValueI = kenshuKbn And otherValueJ = code Then
hasError = True
End If
equaledCols = Array("K")
requiredCols = Array("N")
emptyCols = Array("O", "P", "Q", "R")
ElseIf kenshuKbn = "2" Then
equaledCols = Array("K", "L", "M", "N", "O", "P", "Q")
requiredCols = Array("N", "O", "P", "Q")
emptyCols = Array("R")
ElseIf kenshuKbn = "3" Then
equaledCols = Array("K", "L", "M")
requiredCols = Array()
emptyCols = Array("N", "O", "P", "Q", "R")
End If
If hasError = True Then
errorCell.Value = GetErrorMsg("E013", otherRow, code)
ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next otherRow
' equaledCols must match cache values
Dim equaledIndex As Long
For equaledIndex = LBound(equaledCols) To UBound(equaledCols)
Dim equaledCol As String: equaledCol = equaledCols(equaledIndex)
Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value)
If cache(code)(equaledIndex) <> equalValue Then
errorCell.Value = GetErrorMsg(ERR_INVALID, equaledCol & rowNum)
ws.Range(equaledCol & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next equaledIndex
' requiredCols must not be empty
Dim requiredCol As Variant
For Each requiredCol In requiredCols
Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value)
If requiredValue = "" Then
errorCell.Value = GetErrorMsg(ERR_REQUIRED, requiredCol & rowNum)
ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next requiredCol
' emptyCols must be empty
Dim emptyCol As Variant
For Each emptyCol In emptyCols
Dim emptyValue As String: emptyValue = Trim(ws.Range(emptyCol & rowNum).Value)
If emptyValue <> "" Then
errorCell.Value = GetErrorMsg("E005", emptyCol & rowNum)
ws.Range(emptyCol & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next emptyCol
' Duplicate: C + I + J (+ N if kenshuKbn=1)
Dim sikyuKikan As String: sikyuKikan = Trim(ws.Range("N" & rowNum).Value)
Dim hasError As Boolean: hasError = False
Dim otherValueC As String, otherValueI As String, otherValueJ As String, otherValueN As String
Dim otherRow As Long
For otherRow = 7 To rowNum - 1
otherValueC = Trim(ws.Cells(otherRow, "C").Value)
otherValueI = Trim(ws.Cells(otherRow, "I").Value)
otherValueJ = Trim(ws.Cells(otherRow, "J").Value)
otherValueN = Trim(ws.Cells(otherRow, "N").Value)
If kenshuKbn = "1" Then
If otherValueC = cValue And otherValueI = kenshuKbn And otherValueJ = code And otherValueN = sikyuKikan Then
hasError = True
End If
Else
If otherValueC = cValue And otherValueI = kenshuKbn And otherValueJ = code Then
hasError = True
End If
End If
If hasError = True Then
errorCell.Value = GetErrorMsg("E013", otherRow, code)
ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next otherRow
End If
' validate passed, clear error cell and setup backcolor
errorCell.ClearContents
Application.EnableEvents = False
Call ChangeBackColor(rowNum)
Application.EnableEvents = True
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
SetLastErrorMsg Err.Description
End Sub
' obtain T1/T2/T3 cache data, and update column K
@@ -320,11 +299,11 @@ Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
Dim cache As Object
Select Case kenshu
Case "1"
Set cache = GetCache("T1")
Set cache = GetCache(CACHE_T1)
Case "2"
Set cache = GetCache("T2")
Set cache = GetCache(CACHE_T2)
Case "3"
Set cache = GetCache("T3")
Set cache = GetCache(CACHE_T3)
Case Else
Exit Sub
End Select

2
src/sh/tuk/sheet/O1.cls
View File

@@ -31,5 +31,5 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
SetLastErrorMsg Err.Description
End Sub

2
src/sh/tuk/sheet/O2.cls
View File

@@ -32,5 +32,5 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
SetLastErrorMsg Err.Description
End Sub

38
src/sh/tuk/sheet/O3.cls Normal file
View File

@@ -0,0 +1,38 @@
' ============================================================
' Module Name: Master_O3_220
' Module Desc: O3 master data management (220)
' Module Methods:
' - Worksheet_Change
' - Validate
' ============================================================
' ============================================================
' Event Handlers
' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
End Sub
' Prevent insert/delete row in header area
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName)
Dim filterRow As Long: filterRow = sheetConf("FilterRow")
If Target.Row < filterRow + 1 Then
Cancel = True
MsgBox "Cannot insert or delete row in header area.", vbExclamation
End If
End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Exit Sub
ErrHandler:
SetLastErrorMsg Err.Description
End Sub

94
src/sh/tuk/sheet/T1.cls
View File

@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
' === Column C changes: Create D 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 G changes: Fill E column ===
If Target.Column = 7 And Target.Row >= 7 Then
Dim cellG As Range
For Each cellG In Target
Dim displayValue As String: displayValue = Trim(cellG.Value)
If displayValue <> "" Then
cellG.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
@@ -27,56 +59,28 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End If
End Sub
'
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' clear C~I columns background color
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
' Build engine: same order as original Validate
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
With engine
.AddRequired "C" ' C: required
.AddChar "C", 3 ' C: exact 3 chars
.AddAlphanumeric "C" ' C: alphanumeric only
.AddDuplicate "C" ' C: no duplicate in prior rows
.AddRequired "D" ' D: required
.AddVarchar "D", 80 ' D: max 80 chars
.AddVarchar "E", 80 ' E: max 80 chars
.AddVarchar "F", 80 ' F: max 80 chars
.AddCheck01 "G" ' G: 0 or 1 only
End With
' C column check
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
Call engine.ValidateRow(ws, rowNum, lastDataRow)
checkResult = CheckChar(ws, rowNum, 3, 3, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
' D column check
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub
' F column check
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
If checkResult = False Then Exit Sub
' G column check
checkResult = Check01(ws, rowNum, 7, errorCol)
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub
SetLastErrorMsg Err.Description
End Sub

179
src/sh/tuk/sheet/T2.cls
View File

@@ -13,6 +13,53 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
' === Column C changes: Create D 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 FillZeroIfEmpty(Me, cell.Row)
Call BuildDisplayDropdown(Me, cell.Row)
End If
Next
End If
' === Column G changes: Fill E column ===
If Target.Column = 7 And Target.Row >= 7 Then
Dim cellG As Range
For Each cellG In Target
Dim displayValue As String: displayValue = Trim(cellG.Value)
If displayValue <> "" Then
cellG.Value = GetCode(displayValue)
End If
Next
End If
Application.EnableEvents = True
Exit Sub
Finally:
HandleError "Worksheet_Change"
Application.EnableEvents = True
End Sub
' Fill H~M with "0" if they are empty when C column (kubun/category) is edited
Private Sub FillZeroIfEmpty(ws As Worksheet, ByVal rowNum As Long)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim zeroFillCols As Variant: zeroFillCols = sheetConf("ZeroFillCols")
Dim colLetter As Variant
For Each colLetter In zeroFillCols
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
ws.Range(colLetter & rowNum).Value = "0"
End If
Next colLetter
End Sub
' Prevent insert/delete row in header area
@@ -27,116 +74,38 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End If
End Sub
'
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' clear C~I columns background color
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
With engine
.AddRequired "C"
.AddAlphanumeric "C"
.AddDuplicate "C"
.AddRequired "D"
.AddVarchar "D", 80
.AddVarchar "E", 80
.AddVarchar "F", 80
.AddCheck01 "G"
.AddRequired "H"
.AddNumber "H", 6
.AddRequired "I"
.AddNumber "I", 5
.AddRequired "J"
.AddNumber "J", 3
.AddRequired "K"
.AddNumber "K", 5
.AddRequired "L"
.AddNumber "L", 3
.AddRequired "M"
.AddNumber "M", 5
End With
' C column check
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
Call engine.ValidateRow(ws, rowNum, lastDataRow)
checkResult = CheckChar(ws, rowNum, 3, 3, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
' D column check
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub
' F column check
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
If checkResult = False Then Exit Sub
' G column check
checkResult = Check01(ws, rowNum, 7, errorCol)
If checkResult = False Then Exit Sub
' H column check number
checkResult = CheckRequired(ws, rowNum, 8, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumber(ws, rowNum, 8, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumberOver(ws, rowNum, 8, 6, errorCol)
If checkResult = False Then Exit Sub
' I column check number
checkResult = CheckRequired(ws, rowNum, 9, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumber(ws, rowNum, 9, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumberOver(ws, rowNum, 9, 5, errorCol)
If checkResult = False Then Exit Sub
' J column check number
checkResult = CheckRequired(ws, rowNum, 10, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumber(ws, rowNum, 10, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumberOver(ws, rowNum, 10, 3, errorCol)
If checkResult = False Then Exit Sub
' K column check number
checkResult = CheckRequired(ws, rowNum, 11, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumber(ws, rowNum, 11, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumberOver(ws, rowNum, 11, 5, errorCol)
If checkResult = False Then Exit Sub
' L column check number
checkResult = CheckRequired(ws, rowNum, 12, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumber(ws, rowNum, 12, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumberOver(ws, rowNum, 12, 3, errorCol)
If checkResult = False Then Exit Sub
' M column check number
checkResult = CheckRequired(ws, rowNum, 13, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumber(ws, rowNum, 13, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumberOver(ws, rowNum, 13, 5, errorCol)
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub
SetLastErrorMsg Err.Description
End Sub

117
src/sh/tuk/sheet/T3.cls
View File

@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
' === Column C changes: Create D 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 G changes: Fill E column ===
If Target.Column = 7 And Target.Row >= 7 Then
Dim cellG As Range
For Each cellG In Target
Dim displayValue As String: displayValue = Trim(cellG.Value)
If displayValue <> "" Then
cellG.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
@@ -27,76 +59,31 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End If
End Sub
'
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' clear C~I columns background color
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
With engine
.AddRequired "C"
.AddChar "C", 3
.AddAlphanumeric "C"
.AddDuplicate "C"
.AddRequired "D"
.AddVarchar "D", 80
.AddVarchar "E", 80
.AddVarchar "F", 80
.AddCheck01 "G"
.AddRequired "H"
.AddNumber "H", 6
.AddRequired "I"
.AddNumber "I", 6
End With
' C column check
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
Call engine.ValidateRow(ws, rowNum, lastDataRow)
checkResult = CheckChar(ws, rowNum, 3, 3, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
' D column check
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub
' F column check
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
If checkResult = False Then Exit Sub
' G column check
checkResult = Check01(ws, rowNum, 7, errorCol)
If checkResult = False Then Exit Sub
' H column check number
checkResult = CheckRequired(ws, rowNum, 8, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumber(ws, rowNum, 8, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumberOver(ws, rowNum, 8, 6, errorCol)
If checkResult = False Then Exit Sub
' I column check number
checkResult = CheckRequired(ws, rowNum, 9, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumber(ws, rowNum, 9, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckNumberOver(ws, rowNum, 9, 6, errorCol)
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub
SetLastErrorMsg Err.Description
End Sub

103
src/sh/tuk/sheet/Z1.cls
View File

@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
' === Column C changes: Create D 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 H 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
@@ -30,63 +62,26 @@ End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
With engine
.AddRequired "C"
.AddChar "C", 3
.AddAlphanumeric "C"
.AddDuplicate "C"
.AddRequired "D"
.AddVarchar "D", 80
.AddVarchar "E", 80
.AddVarchar "F", 80
.AddVarchar "G", 80
.AddCheck01 "H"
.AddVarchar "I", 80
End With
' clear C~I columns background color
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim checkResult As Boolean: checkResult = False
Call engine.ValidateRow(ws, rowNum, lastDataRow)
' C column check
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckChar(ws, rowNum, 3, 3, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckAlphanumeric(ws, rowNum, 3, 3, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
' D column check
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub
' F column check
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
If checkResult = False Then Exit Sub
' G column check
checkResult = CheckVarcharOver(ws, rowNum, 7, 80, errorCol)
If checkResult = False Then Exit Sub
' H column check
checkResult = Check01(ws, rowNum, 8, errorCol)
If checkResult = False Then Exit Sub
' I column check
checkResult = CheckVarcharOver(ws, rowNum, 9, 80, errorCol)
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub
SetLastErrorMsg Err.Description
End Sub

93
src/sh/tuk/sheet/Z2.cls
View File

@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
' === Column C changes: Create D 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 G changes: Fill E column ===
If Target.Column = 7 And Target.Row >= 7 Then
Dim cellG As Range
For Each cellG In Target
Dim displayValue As String: displayValue = Trim(cellG.Value)
If displayValue <> "" Then
cellG.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
@@ -27,56 +59,27 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End If
End Sub
'
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' clear C~I columns background color
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
With engine
.AddRequired "C"
.AddChar "C", 1
.AddAlphanumeric "C"
.AddDuplicate "C"
.AddRequired "D"
.AddVarchar "D", 80
.AddVarchar "E", 80
.AddVarchar "F", 80
.AddCheck01 "G"
End With
' C column check
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
Call engine.ValidateRow(ws, rowNum, lastDataRow)
checkResult = CheckChar(ws, rowNum, 3, 1, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckAlphanumeric(ws, rowNum, 3, 1, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
' D column check
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub
' F column check
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
If checkResult = False Then Exit Sub
' G column check
checkResult = Check01(ws, rowNum, 7, errorCol)
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub
SetLastErrorMsg Err.Description
End Sub

98
src/sh/tuk/sheet/Z3.cls
View File

@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
' === Column C changes: Create D 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 G changes: Fill E column ===
If Target.Column = 7 And Target.Row >= 7 Then
Dim cellG As Range
For Each cellG In Target
Dim displayValue As String: displayValue = Trim(cellG.Value)
If displayValue <> "" Then
cellG.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
@@ -27,60 +59,28 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End If
End Sub
'
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' clear C~I columns background color
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
' C column check
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
With engine
.AddRequired "C"
.AddChar "C", 2
.AddAlphanumeric "C"
.AddDuplicate "C"
.AddRequired "D"
.AddVarchar "D", 80
.AddVarchar "E", 80
.AddVarchar "F", 80
.AddCheck01 "G"
.AddVarchar "H", 80
End With
checkResult = CheckChar(ws, rowNum, 3, 2, errorCol)
If checkResult = False Then Exit Sub
Call engine.ValidateRow(ws, rowNum, lastDataRow)
checkResult = CheckAlphanumeric(ws, rowNum, 3, 2, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
' D column check
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub
' F column check
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
If checkResult = False Then Exit Sub
' G column check
checkResult = Check01(ws, rowNum, 7, errorCol)
If checkResult = False Then Exit Sub
' H column check
checkResult = CheckVarcharOver(ws, rowNum, 8, 80, errorCol)
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub
SetLastErrorMsg Err.Description
End Sub

107
src/sh/tuk/sheet/Z4.cls
View File

@@ -1,6 +1,6 @@
' ============================================================
' Module Name: Master_Z4_220
' Module Desc: Z4 master data management (220)
' Module Name: Master_Z4_221
' Module Desc: Z4 master data management (221)
' Module Methods:
' - Worksheet_Change
' - Validate
@@ -13,6 +13,38 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
' === Column C changes: Create H 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 H 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
@@ -27,64 +59,29 @@ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End If
End Sub
'
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' clear C~I columns background color
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
' C column check
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
With engine
.AddRequired "C"
.AddChar "C", 6
.AddAlphanumeric "C"
.AddDuplicate "C"
.AddRequired "D"
.AddVarchar "D", 80
.AddVarchar "E", 80
.AddRequired "F"
.AddVarchar "F", 80
.AddVarchar "G", 80
.AddCheck01 "H"
End With
checkResult = CheckChar(ws, rowNum, 3, 2, errorCol)
If checkResult = False Then Exit Sub
Call engine.ValidateRow(ws, rowNum, lastDataRow)
checkResult = CheckAlphanumeric(ws, rowNum, 3, 2, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
' D column check
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub
' F column check
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
If checkResult = False Then Exit Sub
' G column check
checkResult = Check01(ws, rowNum, 7, errorCol)
If checkResult = False Then Exit Sub
' H column check
checkResult = CheckVarcharOver(ws, rowNum, 8, 80, errorCol)
If checkResult = False Then Exit Sub
' I column check
checkResult = Check12(ws, rowNum, 9, errorCol)
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub
SetLastErrorMsg Err.Description
End Sub

31
src/sh/tuk/validation/ValidationResult.cls Normal file
View File

@@ -0,0 +1,31 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ValidationResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Passed As Boolean
Public ErrorCode As String
Public ErrorCol As Long
Public ErrorRow As Long
Public Extra As String ' extra info per rule type (e.g. duplicate value for ERR_DUPLICATE)
Private Sub Class_Initialize()
Passed = True
End Sub
' ============================================================
' Mark this result as a failure.
' ============================================================
Public Sub SetFail(errorCode As String, errorCol As Long, errorRow As Long, Optional extra As String = "")
Passed = False
Me.ErrorCode = errorCode
Me.ErrorCol = errorCol
Me.ErrorRow = errorRow
Me.Extra = extra
End Sub

161
src/sh/tuk/validation/ValidationRule.cls Normal file
View File

@@ -0,0 +1,161 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ValidationRule"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' --- Properties ---
' RuleKind (ValRule_*), ColIndex, ColLetter, CacheName, MinVal, MaxVal,
' CharLen, VarcharLen, NumberDigits, NumberDec, StartRow
Public RuleKind As Long
Public ColIndex As Long
Public ColLetter As String
Public CacheName As String
Public MinVal As Double
Public MaxVal As Double
Public CharLen As Long
Public VarcharLen As Long
Public NumberDigits As Long
Public NumberDec As Long
Public StartRow As Long
' --- Error Codes ---
Private Const ERR_REQUIRED As String = "E002"
Private Const ERR_INVALID As String = "E001"
Private Const ERR_RANGE As String = "E004"
Private Const ERR_NOT_EXIST As String = "E004"
Private Const ERR_DUPLICATE As String = "E010"
Private Const ERR_CHARLEN As String = "E006"
Private Const ERR_VARLEN As String = "E007"
Private Const ERR_CHECK01 As String = "E008"
Private Const ERR_NUMDIGITS As String = "E014"
' ============================================================
' Execute this rule against a worksheet row.
' Returns a ValidationResult object.
' ============================================================
Public Function ValidateRow(ws As Worksheet, rowNum As Long, Optional lastDataRow As Long = 0) As ValidationResult
Dim result As ValidationResult: Set result = New ValidationResult
Select Case RuleKind
Case ValRule_Required
If Trim(ws.Cells(rowNum, ColIndex).Value & "") = "" Then
result.SetFail ERR_REQUIRED, ColIndex, rowNum
End If
Case ValRule_Date
Dim dateVal As String: dateVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
If dateVal <> "" Then
If Len(dateVal) <> 10 Or Mid(dateVal, 5, 1) <> "-" Or Mid(dateVal, 8, 1) <> "-" Then
result.SetFail ERR_INVALID, ColIndex, rowNum
End If
End If
Case ValRule_Number
Dim numVal As String: numVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
If numVal <> "" Then
If Not IsNumeric(numVal) Then
result.SetFail ERR_INVALID, ColIndex, rowNum
ElseIf NumberDigits > 0 Or NumberDec > 0 Then
Dim dotPos As Long: dotPos = InStr(numVal, ".")
Dim intPart As String
Dim decPart As String
If dotPos > 0 Then
intPart = Left(numVal, dotPos - 1)
decPart = Mid(numVal, dotPos + 1)
Else
intPart = numVal
decPart = ""
End If
If Left(intPart, 1) = "-" Then intPart = Mid(intPart, 2)
If Len(intPart) = 0 Then
result.SetFail ERR_NUMDIGITS, ColIndex, rowNum, "Number(" & NumberDigits & ", " & NumberDec & ")"
ElseIf Len(intPart) > NumberDigits - NumberDec Then
result.SetFail ERR_NUMDIGITS, ColIndex, rowNum, "Number(" & NumberDigits & ", " & NumberDec & ")"
ElseIf NumberDec > 0 And Len(decPart) > NumberDec Then
result.SetFail ERR_NUMDIGITS, ColIndex, rowNum, "Number(" & NumberDigits & ", " & NumberDec & ")"
End If
End If
End If
Case ValRule_CodeSelect
Dim codeVal As String: codeVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
If codeVal <> "" Then
Dim cache As Object: Set cache = GetCache(CacheName)
Dim code As String: code = GetCode(codeVal)
If Not cache.Exists(code) Then
result.SetFail ERR_NOT_EXIST, ColIndex, rowNum
End If
End If
Case ValRule_Range
Dim rangeVal As String: rangeVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
If rangeVal <> "" Then
If Not IsNumeric(rangeVal) Then
result.SetFail ERR_INVALID, ColIndex, rowNum
ElseIf CDbl(rangeVal) < MinVal Or CDbl(rangeVal) > MaxVal Then
result.SetFail ERR_RANGE, ColIndex, rowNum
End If
End If
Case ValRule_Duplicate
Dim dupVal As String: dupVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
If dupVal <> "" Then
Dim upperRow As Long: upperRow = rowNum - 1
Dim firstRow As Long: firstRow = IIf(StartRow > 0, StartRow, 7)
Dim i As Long
For i = firstRow To upperRow
If Trim(ws.Cells(i, ColIndex).Value & "") = dupVal Then
result.SetFail ERR_DUPLICATE, ColIndex, rowNum, dupVal
Exit For
End If
Next i
End If
Case ValRule_Char
Dim charVal As String: charVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
If charVal <> "" And Len(charVal) <> CharLen Then
result.SetFail ERR_CHARLEN, ColIndex, rowNum, CStr(CharLen)
End If
Case ValRule_Varchar
Dim varcharVal As String: varcharVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
If varcharVal <> "" And Len(varcharVal) > VarcharLen Then
result.SetFail ERR_VARLEN, ColIndex, rowNum, CStr(VarcharLen)
End If
Case ValRule_Check01
Dim chk01Val As String: chk01Val = Trim(ws.Cells(rowNum, ColIndex).Value & "")
If chk01Val <> "" Then
If Len(chk01Val) <> 1 Or (chk01Val <> "0" And chk01Val <> "1") Then
result.SetFail ERR_CHECK01, ColIndex, rowNum
End If
End If
Case ValRule_Alphanumeric
Dim alphaVal As String: alphaVal = Trim(ws.Cells(rowNum, ColIndex).Value & "")
If alphaVal <> "" Then
Dim j As Long
Dim ch2 As String
For j = 1 To Len(alphaVal)
ch2 = Mid(alphaVal, j, 1)
If Not ((ch2 >= "0" And ch2 <= "9") Or (ch2 >= "A" And ch2 <= "Z") Or (ch2 >= "a" And ch2 <= "z")) Then
result.SetFail ERR_INVALID, ColIndex, rowNum
Exit For
End If
Next j
End If
Case ValRule_Custom
' Reserved for future extension
End Select
Set ValidateRow = result
End Function

180
src/sh/tuk/validation/ValidationRuleEngine.cls Normal file
View File

@@ -0,0 +1,180 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ValidationRuleEngine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private pRules As VBA.Collection
Private Sub Class_Initialize()
Set pRules = New VBA.Collection
End Sub
' ============================================================
' Add a Required rule directly (convenience method).
' ============================================================
Public Sub AddRequired(ByVal colIndex As String)
Dim r As ValidationRule: Set r = New ValidationRule
r.RuleKind = ValRule_Required
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
pRules.Add r
Set r = Nothing
End Sub
Public Sub AddDate(colIndex As Variant)
Dim r As ValidationRule: Set r = New ValidationRule
r.RuleKind = ValRule_Date
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
pRules.Add r
Set r = Nothing
End Sub
Public Sub AddNumber(colIndex As Variant, Optional totalDigits As Long = 0, Optional decimalDigits As Long = 0)
Dim r As ValidationRule: Set r = New ValidationRule
r.RuleKind = ValRule_Number
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
If totalDigits > 0 Then r.NumberDigits = totalDigits
If decimalDigits > 0 Then r.NumberDec = decimalDigits
pRules.Add r
Set r = Nothing
End Sub
Public Sub AddCodeSelect(colIndex As Variant, cacheName As String)
Dim r As ValidationRule: Set r = New ValidationRule
r.RuleKind = ValRule_CodeSelect
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
r.CacheName = cacheName
pRules.Add r
Set r = Nothing
End Sub
Public Sub AddRange(colIndex As Variant, minVal As Double, maxVal As Double)
Dim r As ValidationRule: Set r = New ValidationRule
r.RuleKind = ValRule_Range
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
r.MinVal = minVal
r.MaxVal = maxVal
pRules.Add r
Set r = Nothing
End Sub
Public Sub AddDuplicate(colIndex As Variant, Optional firstRow As Long = 0)
Dim r As ValidationRule: Set r = New ValidationRule
r.RuleKind = ValRule_Duplicate
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
If firstRow > 0 Then r.StartRow = firstRow
pRules.Add r
Set r = Nothing
End Sub
Public Sub AddChar(colIndex As Variant, charLen As Long)
Dim r As ValidationRule: Set r = New ValidationRule
r.RuleKind = ValRule_Char
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
r.CharLen = charLen
pRules.Add r
Set r = Nothing
End Sub
Public Sub AddVarchar(colIndex As Variant, maxLen As Long)
Dim r As ValidationRule: Set r = New ValidationRule
r.RuleKind = ValRule_Varchar
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
r.VarcharLen = maxLen
pRules.Add r
Set r = Nothing
End Sub
Public Sub AddCheck01(colIndex As Variant)
Dim r As ValidationRule: Set r = New ValidationRule
r.RuleKind = ValRule_Check01
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
pRules.Add r
Set r = Nothing
End Sub
Public Sub AddAlphanumeric(colIndex As Variant)
Dim r As ValidationRule: Set r = New ValidationRule
r.RuleKind = ValRule_Alphanumeric
r.ColIndex = IIf(IsNumeric(colIndex), colIndex, ColNum(CStr(colIndex)))
pRules.Add r
Set r = Nothing
End Sub
' ============================================================
' Run all rules against the given row.
' Clears row background at start, outputs error on failure.
' lastDataRow is required when Duplicate rules are registered.
' Returns Nothing if all rules pass.
' ============================================================
Public Function ValidateRow(ws As Worksheet, rowNum As Long, Optional lastDataRow As Long = 0) As ValidationResult
' Clear row background
Call ClearRowBg(ws, rowNum)
Dim r As ValidationRule
Dim result As ValidationResult
For Each r In pRules
Set result = r.ValidateRow(ws, rowNum, lastDataRow)
If Not result.Passed Then
Call OutputError(ws, rowNum, result)
Set ValidateRow = result
Exit Function
End If
Next r
' All passed
Set ValidateRow = New ValidationResult
End Function
' ============================================================
' Number of rules registered.
' ============================================================
Public Property Get RuleCount() As Long
RuleCount = pRules.Count
End Property
' ============================================================
' Clear background color for the given row.
' Uses the colIndex of each registered rule to build the range.
' Call this before running ValidateRow.
' ============================================================
Public Sub ClearRowBg(ws As Worksheet, rowNum As Long)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim errorCol As Long: errorCol = ColNum(CStr(sheetConf("ErrorCol")))
Dim endCol As Long: endCol = ColNum(CStr(sheetConf("EndCol")))
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, errorCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
ws.Cells(rowNum, errorCol).ClearContents
End Sub
' ============================================================
' Write error message and highlight the failed cell.
' Resolves errorCol from sheet config internally.
' Call this after ValidateRow when result.Passed = False.
' ============================================================
Public Sub OutputError(ws As Worksheet, rowNum As Long, result As ValidationResult)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim errorCol As Long: errorCol = ColNum(CStr(sheetConf("ErrorCol")))
If result.Passed Then
If Not StartsWith(ws.Cells(rowNum, errorCol).Value, "W") Then
ws.Cells(rowNum, errorCol).ClearContents
End If
Else
Dim cellAddr As String: cellAddr = ColLetter(result.ErrorCol)
ws.Cells(rowNum, errorCol).Value = GetErrorMsg(result.ErrorCode, cellAddr & CStr(result.ErrorRow), result.Extra)
ws.Cells(rowNum, result.ErrorCol).Interior.Color = RGB(255, 0, 0)
End If
End Sub

BIN
通勤手当テンプレート20260525.xlsm
View File

Binary file not shown.

BIN
通勤手当テンプレート20260528.xlsm Normal file
View File

Binary file not shown.