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

cache refactor

Browse Source
This commit is contained in:
updsv7
2026-04-22 19:43:18 +09:00
parent 1056cb1d1b
commit 1c200c6820
17 changed files with 526 additions and 607 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
README.md Normal file
View File

@@ -0,0 +1,54 @@
# Commuter Allowance VBA Project
Excel VBA commuter allowance calculation tool.
## Structure
```
vba/
├── 通勤手当テンプレート_案.xlsm # Main workbook
├── data/ # CSV data files
│ ├── 222交通機関名区分.csv # Transport type (222)
│ ├── 223通勤_決定事項区分.csv # Decision factors (223)
│ ├── 224通勤_手当月額の決定区分.csv # Monthly amount (224)
│ ├── 507発信者.csv # Sender (507)
│ ├── 区間.csv # Route (section)
│ └── 区間詳細.csv # Route details
└── src/
├── module/ # Common modules
│ ├── Common_Button.bas (306 lines)
│ ├── Common_File_Utils.bas (347 lines)
│ ├── Common_Functions.bas (478 lines)
│ ├── Common_Global_Cache.bas (817 lines)
│ └── Common_Selector.bas (161 lines)
├── init_module/ # Init modules
│ ├── Import_modules.bas
│ └── Test_Cache.bas
└── sheet/ # Sheet classes
├── C1.cls (842 lines) - Tukin_C1: Commuter allowance editing
├── M1.cls (164 lines) - Master_Kukan: Route master (import/export/validate)
├── M2.cls (386 lines) - Master_Kukan_detail: Route detail master
├── O1.cls (5 lines) - Master_address: Address master
├── O2.cls (6 lines) - Master_507: Sender master (507)
├── T1.cls (57 lines) - Master_244: Route master (244)
├── T2.cls (117 lines) - Master_245: Route master (245)
├── T3.cls (77 lines) - Master_246
├── Z1.cls (67 lines) - Master_222: Transport type master
├── Z2.cls (57 lines) - Master_223: Decision factors master
├── Z3.cls (60 lines) - Master_224: Monthly amount master
└── Z4.cls (64 lines) - Master_225
```
## Sheet Class Prefix
| Prefix | Description |
|--------|-------------|
| C | Commuter allowance editing |
| M | Menu / Route master |
| O | Other masters |
| T | Route (通勤区間) |
| Z | Master data configuration |
## License
MIT

2
documents/Tukin_Cache_Mapping.md
View File

@@ -32,6 +32,8 @@
|--------|--------|--------|
|ヘッダ|区分|手当月額の決定|
### t1Cache
### o1Cache 住所情報
|列|C列|E列|F列|
|--------|--------|--------|--------|

72
src/module/Common_Button.bas
View File

@@ -31,7 +31,25 @@ Sub Fit_Button()
End Sub
Sub RefreshCache_Button()
Dim result As Boolean: result = RefreshCache()
Dim cacheSheets As Variant: cacheSheets = Array("M1", "M2", "Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1","O2")
Dim sheetName As Variant
Dim ws As Worksheet
For Each sheetName In cacheSheets
If ProcedureExists(sheetName, "Validate") Then
Dim errorCount As Long
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(CStr(sheetName))
On Error GoTo 0
Dim isValid As Boolean: isValid = RunValidationSilent(ws, errorCount)
If isValid = False Then
MsgBox "Can't refresh " & sheetName & " cache. Validation error occurs."
Exit Sub
End If
End If
Next sheetName
Dim result As Boolean: result = RefreshAllCache()
If result = True Then
MsgBox "master data reload successfully."
End If
@@ -79,6 +97,11 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet)
writeRow = writeRow + 1
Next i
' === Step 5: Trigger sheet-specific import handler ===
If ProcedureExists(ws.CodeName, "ImportCSVAndTriggerChange") Then
Call Application.Run(ws.CodeName & ".ImportCSVAndTriggerChange", ws, writeRow)
End If
MsgBox writeRow - cfg("StartRow") & " rows imported.", vbInformation
GoTo FinallyExit
@@ -94,13 +117,7 @@ End Sub
Private Sub Do_Validation(ws As Excel.Worksheet)
On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' step1. confirm Validate Sub
Dim validate As String
validate = ws.CodeName & ".Validate"
If Not ProcedureExists(ws.CodeName, "Validate") Then
MsgBox "worksheet """ & ws.name & """ unimplement methods", vbExclamation
Exit Sub
@@ -116,11 +133,7 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
ElseIf errorCount > 0 Then
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
Else
'There is no error
Dim cacheMethodName As String: cacheMethodName = Trim(sheetConf("RefreshCacheName"))
If cacheMethodName <> "" Then
Application.Run cacheMethodName
End If
RefreshCache(ws.CodeName)
MsgBox "Validation complete. Errors: 0", vbInformation
End If
@@ -208,7 +221,30 @@ ExportError:
End Sub
Private Sub Do_Sort(ws As Excel.Worksheet)
'
On Error GoTo ErrorHandler
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 startRow As Long: startRow = sheetConf("StartRow")
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
If lastDataRow < startRow Then
MsgBox "No data to sort.", vbExclamation
Exit Sub
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.Dialogs(xlDialogSort).Show
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbCritical
End Sub
Private Sub Do_Filter(ws As Excel.Worksheet)
@@ -253,7 +289,7 @@ ErrorHandler:
End Sub
' RunValidationSilent
private Function RunValidationSilent(ws As Worksheet, Optional ByRef errorCountOut As Long = 0) As Boolean
Public Function RunValidationSilent(ws As Worksheet, Optional ByRef errorCountOut As Long = 0) As Boolean
On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -296,12 +332,18 @@ ErrorHandler:
RunValidationSilent = False
End Function
Private Function ProcedureExists(moduleName As String, procName As String) As Boolean
Public Function ProcedureExists(ByVal moduleName As String, ByVal procName As String) As Boolean
Dim VBProj As Object, VBComp As Object, CodeMod As Object
On Error Resume Next
Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents(moduleName)
If Not VBComp Is Nothing Then
Set CodeMod = VBComp.CodeModule
ProcedureExists = (CodeMod.ProcStartLine(procName, 0) > 0)
End If
If Err.Number <> 0 Then ProcedureExists = False
On Error GoTo 0
End Function

88
src/module/Common_Functions.bas
View File

@@ -69,36 +69,61 @@ Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
End Function
Function Contains(ByVal arr As Variant, ByVal value As String) As Boolean
Dim i As Long
For i = 0 To UBound(arr)
If arr(i) = value Then
Contains = True
Exit Function
End If
Next i
Contains = False
End Function
' @return dict : key = keyCol，value = Array
' @param sheetName
' @param keyCol
' @param valueCols Array(4,5,6)
' @param startRow default is 7
Function LoadLookup( _
ByVal sheetName As String, _
ByVal keyCol As Long, _
ByVal valueCols As Variant, _
Optional ByVal startRow As Long = 7 _
) As Object
Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Object
On Error GoTo ErrHandler
' --- validate ---
If Trim(sheetName) = "" Then Exit Function
If Not IsArray(valueCols) Then
valueCols = Array(valueCols)
If Trim(sheetName) = "" Then Err.Raise 0001, "LoadLookup", "Sheet name cannot be empty."
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
If Not sheetConfDict.Exists(sheetName) Then
Err.Raise 1004, "LoadLookup", "Sheet not configured: " & sheetName
End If
Dim nValCols As Long: nValCols = UBound(valueCols) - LBound(valueCols) + 1
If nValCols = 0 Then Exit Function
' --- obtain worksheet ---
On Error Resume Next
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(sheetName)
On Error GoTo 0
If ws Is Nothing Then Exit Function
' --- obtain data（based on keyCol）---
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row
If lastRow < startRow Then Exit Function
If ws Is Nothing Then Err.Raise 0003, "LoadLookup", "Worksheet named '" & sheetName & "' not found."
On Error GoTo ErrHandler
Dim sheetConf As Object: Set sheetConf = sheetConfDict(cacheName)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim keyCol As Long: keyCol = sheetConf("KeyCol")
Dim valueCols As Variant: valueCols = sheetConf("ValueCols")
Dim lastRow As Long
If sheetName <> cacheName Then
lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row
Else
lastRow = GetLastDataRowInRange(ws)
End If
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
If lastRow < startRow Then
Set LoadLookup = dict
Exit Function
End If
Dim nValCols As Long: nValCols = UBound(valueCols) - LBound(valueCols) + 1
If nValCols = 0 Then Err.Raise 0002, "LoadLookup", "Value columns parameter is invalid."
' --- prepare col ---
Dim minCol As Long: minCol = keyCol
Dim maxCol As Long: maxCol = keyCol
@@ -133,7 +158,6 @@ Function LoadLookup( _
Next i
' --- write into ---
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim r As Long
@@ -150,6 +174,10 @@ Function LoadLookup( _
Next r
Set LoadLookup = dict
Exit Function
ErrHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Function
' obtain
@@ -205,7 +233,6 @@ Sub ClearDataRows(ByVal ws As Worksheet)
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")
@@ -320,8 +347,27 @@ Public Function FormatDateInput(ByVal inputStr As String) As String
End If
End Function
Function CheckHeaderEdit(ByVal ws As Worksheet, ByVal Target As Range) As Boolean
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim headerRow As Long: headerRow = sheetConf("HeaderRow")
' Check header row (headerRow) cannot be edited
If Target.Row = headerRow Then
Application.EnableEvents = False
MsgBox "Header row can not be edit", vbExclamation
Application.Undo
Application.EnableEvents = True
CheckHeaderEdit = True
Exit Function
End If
CheckHeaderEdit = False
End Function
Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String = "", Optional ByVal param1 As String = "") As String
Dim errorList As Object: Set errorList = GetErrorList()
Dim errorList As Object: Set errorList = GetCache("errorList")
Dim errorMessage As String
If errorList.Exists(errorCode) Then
errorMessage = Replace(errorList(errorCode)(0), "{0}", param0)

779
src/module/Common_Global_Cache.bas
View File

File diff suppressed because it is too large Load Diff

16
src/module/Common_Selector.bas
View File

@@ -17,7 +17,7 @@ Option Explicit
' Create transport (T) dropdown from Z1 cache
Public Function BuildTransportList()
Dim z1Cache As Object: Set z1Cache = GetZ1Cache()
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
Dim dropdownList As String
Dim key As Variant
@@ -36,7 +36,7 @@ End Function
' Create todoke (G) dropdown
Public Function BuildTodokeList()
Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim dropdownList As String
Dim key As Variant
@@ -54,7 +54,7 @@ End Function
' Create oufuku (M) dropdown
Public Function BuildOufukuList()
Dim oufukuList As Object: Set oufukuList = GetOufukuList()
Dim oufukuList As Object: Set oufukuList = GetCache("oufukuList")
Dim dropdownList As String
Dim key As Variant
@@ -72,7 +72,7 @@ End Function
' Create Koutai (N) dropdown
Public Function BuildKoutaiList()
Dim koutaiList As Object: Set koutaiList = GetKoutaiList()
Dim koutaiList As Object: Set koutaiList = GetCache("koutaiList")
Dim dropdownList As String
Dim key As Variant
@@ -90,7 +90,7 @@ End Function
' Create Kettei (AU) dropdown
Public Function BuildKetteiList()
Dim z2Cache As Object: Set z2Cache = GetZ2Cache()
Dim z2Cache As Object: Set z2Cache = GetCache("Z2")
Dim dropdownList As String
Dim key As Variant
@@ -108,7 +108,7 @@ End Function
' Create Higaitou (AW) dropdown
Public Function BuildHigaitouList()
Dim higaitouList As Object: Set higaitouList = GetHigaitouList()
Dim higaitouList As Object: Set higaitouList = GetCache("higaitouList")
Dim dropdownList As String
Dim key As Variant
@@ -126,7 +126,7 @@ End Function
' Create MonthAmountKbn (AX) dropdown
Public Function BuildMonthAmountKbnList()
Dim z3Cache As Object: Set z3Cache = GetZ3Cache()
Dim z3Cache As Object: Set z3Cache = GetCache("Z3")
Dim dropdownList As String
Dim key As Variant
@@ -144,7 +144,7 @@ End Function
' Create Kanshoku (BC) dropdown
Public Function BuildKanshokuList()
Dim o2Cache As Object: Set o2Cache = GetO2Cache()
Dim o2Cache As Object: Set o2Cache = GetCache("O2")
Dim dropdownList As String
Dim key As Variant

36
src/sheet/C1.cls
View File

@@ -72,6 +72,10 @@ End Function
' Event Handlers
' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Dim watchArea As Range
With Me
Set watchArea = Union( _
@@ -118,7 +122,7 @@ 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 = GetZ4Cache()
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim todokeCde As String: todokeCde = GetCode(todoke)
If z4Cache.Exists(todokeCde) Then
Dim cellH As Range: Set cellH = Me.Cells(cellG.Row, 8)
@@ -274,7 +278,7 @@ End Sub
' Fill kukan info from M1 cache (key: kukan code, value: 7 elements)
Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long)
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
Dim codeCol As Long: codeCol = KUKAN_CODE_COLS(idx)
Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx)
@@ -309,7 +313,7 @@ End Sub
' triggered by c clomun cshainno input
Private Sub CreateAddress1Dropdown(ByVal rowNum As Long)
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim empNo As String
empNo = Trim(Me.Cells(rowNum, 3).Value)
@@ -345,7 +349,7 @@ End Sub
' triggered by address1 select O1 cache
Private Sub CreateAddress2Dropdown(ByVal rowNum As Long)
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim empNo As String
empNo = Trim(Me.Cells(rowNum, 3).Value)
@@ -399,7 +403,7 @@ End Sub
' Create station from dropdown from M1_KukanD cache
Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long)
Dim m1KukanDCache As Object: Set m1KukanDCache = GetM1KukanDCache()
Dim m1KukanDCache As Object: Set m1KukanDCache = GetCache("M1KukanDCache")
Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
If transport = "" Then Exit Sub
@@ -431,8 +435,8 @@ End Sub
' Create Kenshu dropdown from
' Structure: { D: { F: [G] } }
Private Sub CreateKenshuDropdown(ByVal rowNum As Long, ByVal idx As Long, ByVal kukanCode As String)
Dim kenshuList As Object: Set kenshuList = GetKenshuList()
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(idx)
Me.Cells(rowNum, ticketCol).ClearContents
@@ -464,7 +468,7 @@ End Sub
' Create destination dropdown from M1_KukanD cache
' Structure: { D: { F: [G] } }
Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long)
Dim m1KukanDCache As Object: Set m1KukanDCache = GetM1KukanDCache()
Dim m1KukanDCache As Object: Set m1KukanDCache = GetCache("M1KukanDCache")
Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
Dim stationFrom As String: stationFrom = GetCode(Me.Cells(rowNum, stationFromCol).Value)
@@ -499,7 +503,7 @@ End Sub
' Find kukan code by transport + station_from + station_to (reverse lookup)
Private Function FindKukanCodeByStation(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) As String
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
Dim transportKbn As String: transportKbn = GetCode(Trim(Me.Cells(rowNum, transportCol).Value))
Dim stationFrom As String: stationFrom = Trim(Me.Cells(rowNum, stationFromCol).Value)
@@ -530,7 +534,7 @@ End Sub
' Create dropdown from M2 cache: get code (J) list for kukanCode + kanshu
Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long)
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
Dim kanshuStr As String: kanshuStr = Trim(Me.Cells(rowNum, kanshuCol).Value)
@@ -634,7 +638,7 @@ 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 = GetZ4Cache()
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value))
If Not z4Cache.Exists(todokeCde) Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColG & rowNum)
@@ -643,7 +647,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
' I column [address1 J column address2]
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim ColI As String: ColI = "I"
Dim ColJ As String: ColJ = "J"
Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ColI).Value)
@@ -687,7 +691,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' validate CodeSelect
' M column [oufuku]
Dim ColM As String: ColM = "M"
Dim oufukuList As Object: Set oufukuList = GetOufukuList()
Dim oufukuList As Object: Set oufukuList = GetCache("oufukuList")
Dim oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value))
If Not oufukuList.Exists(oufukuCde) Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColM & rowNum)
@@ -698,7 +702,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' validate CodeSelect
' N column [koutai]
Dim ColN As String: ColN = "N"
Dim koutaiList As Object: Set koutaiList = GetKoutaiList()
Dim koutaiList As Object: Set koutaiList = GetCache("koutaiList")
Dim koutaiCde As String: koutaiCde = GetCode(Trim(Me.Cells(rowNum, ColN).Value))
If Not koutaiList.Exists(koutaiCde) Then
Me.Cells(rowNum, errorCol).Value = ColN & " column is invalid"
@@ -707,8 +711,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
' validate KUKAN_CODE_COLS (S, Z, AG, AN) and related columns
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
Dim kukanCols As Variant
kukanCols = Array(KUKAN_TRANSPORT_COLS, KUKAN_STATION_COLS, KUKAN_ARRIVAL_COLS, KUKAN_TICKET_COLS, KUKAN_CODE2_COLS, KUKAN_START_DAY_COLS)

13
src/sheet/M1.cls
View File

@@ -9,7 +9,7 @@
' Create dropdown for L column
Private Sub CreateEnumDropdown(ByVal rowNum As Long)
Dim tokubetuList As Object: Set tokubetuList = GetTokubetu()
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
' Build dropdown list from tokubetuList
Dim dropdownList As String
dropdownList = ""
@@ -36,6 +36,9 @@ End Sub
'
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
' === Column C changes: Create L column dropdown ===
If Target.Column = 3 And Target.Row >= 7 Then
Dim cell As Range
@@ -51,7 +54,7 @@ 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 = GetZ1Cache()
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
Dim cellD As Range
For Each cellD In Target
@@ -115,7 +118,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
' Check D and E column in the cache
Dim z1Cache As Object: Set z1Cache = GetZ1Cache()
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)
@@ -143,7 +146,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
' Check L column in the tokubetuList
Dim tokubetuList As Object: Set tokubetuList = GetTokubetu()
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
ws.Cells(rowNum, errorCol).Value = "L column does not exist."
@@ -152,7 +155,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
' Check if M2 uses this M1 kukan code
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
If Not m2Cache.Exists(cValue) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("W001", cValue)
ws.Range("C" & rowNum).Interior.Color = RGB(255, 128, 0)

52
src/sheet/M2.cls
View File

@@ -8,6 +8,11 @@
' - Validate
' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
If Target.EntireRow.Address = Target.Address Then Exit Sub
Dim watchArea As Range
With Me
Set watchArea = Union( _
@@ -29,6 +34,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target
If Trim(cell.Value) = "" Then
Call ClearRowData(Me, cell.Row)
GoTo Finally
Else
Call FillFromM1(cell.Row)
End If
@@ -95,11 +101,11 @@ Private Sub FillKFromJ(ByVal rowNum As Long)
Dim cache As Object
Select Case iValue
Case "1"
Set cache = GetT1Cache()
Set cache = GetCache("T1")
Case "2"
Set cache = GetT2Cache()
Set cache = GetCache("T2")
Case "3"
Set cache = GetT3Cache()
Set cache = GetCache("T3")
Case Else
Exit Sub
End Select
@@ -145,14 +151,14 @@ Private Sub CreateJDropdown(ByVal rowNum As Long)
Dim cache As Object
Select Case iValue
Case "1"
Set cache = GetT1Cache()
Set cache = GetCache("T1")
Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
Case "2"
Set cache = GetT2Cache()
Set cache = GetCache("T2")
Case "3"
Set cache = GetT3Cache()
Set cache = GetCache("T3")
Me.Range("N" & rowNum).Interior.Color = RGB(192, 192, 192)
Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
@@ -187,7 +193,7 @@ End Sub
Private Sub FillFromM1(ByVal rowNum As Long)
Set ws = Me
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
' Fill D, E, F, G, H columns from M1 cache
@@ -223,9 +229,10 @@ End Sub
Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
' Clear from D column onwards
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
ws.Cells(rowNum, 6).Validation.Delete
ws.Cells(rowNum, 19).ClearContents ' Q column error info
ws.Range(ws.Cells(rowNum, "D"), ws.Cells(rowNum, "R")).ClearContents
ws.Range(ws.Cells(rowNum, "C"), ws.Cells(rowNum, "R")).Interior.Color = vbWhite
ws.Cells(rowNum, "J").Validation.Delete
ws.Cells(rowNum, "S").ClearContents
End Sub
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
@@ -241,19 +248,19 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
clearRange.Interior.Color = vbWhite
' Check C column in the cache
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
' 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
If Not m1Cache.Exists(cValue) Then
ws.Cells(rowNum, errorCol).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")
@@ -277,7 +284,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Next col
' Check I column in the kenshuKbn
Dim kenshuList As Object: Set kenshuList = GetKenshuList()
Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value)
If Not kenshuList.Exists(kenshuKbn) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E012", "I" & rowNum)
@@ -299,7 +306,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim equaledCols As Variant
Dim emptyCols As Variant
If kenshuKbn = "1" Then
Set cache = GetT1Cache()
Set cache = GetCache("T1")
' must input
equaledCols = Array("K")
requiredCols = Array("N")
@@ -307,7 +314,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
If kenshuKbn = "2" Then
Set cache = GetT2Cache()
Set cache = GetCache("T2")
' must input
equaledCols = Array("K", "L", "M", "N", "O", "P", "Q")
requiredCols = Array("N", "O", "P", "Q")
@@ -315,7 +322,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
If kenshuKbn = "3" Then
Set cache = GetT3Cache()
Set cache = GetCache("T3")
' must input
equaledCols = Array("K", "L", "M")
requiredCols = Array()
@@ -381,6 +388,13 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End Sub
Sub ImportCSVAndTriggerChange(ws As Worksheet)
' TODO
Public Sub ImportCSVAndTriggerChange(ws As Worksheet, ByVal lastDataRow As Long)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim i As Long
For i = startRow To lastDataRow
Call FillFromM1(i)
Next i
End Sub

3
src/sheet/T1.cls
View File

@@ -39,9 +39,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

3
src/sheet/T2.cls
View File

@@ -39,9 +39,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

3
src/sheet/T3.cls
View File

@@ -39,9 +39,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

3
src/sheet/Z1.cls
View File

@@ -41,9 +41,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

3
src/sheet/Z2.cls
View File

@@ -39,9 +39,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

3
src/sheet/Z3.cls
View File

@@ -38,9 +38,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

3
src/sheet/Z4.cls
View File

@@ -38,9 +38,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

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

Binary file not shown.