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 住所情報 ### o1Cache 住所情報
|列|C列|E列|F列| |列|C列|E列|F列|
|--------|--------|--------|--------| |--------|--------|--------|--------|

72
src/module/Common_Button.bas
View File

@@ -31,7 +31,25 @@ Sub Fit_Button()
End Sub End Sub
Sub RefreshCache_Button() 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 If result = True Then
MsgBox "master data reload successfully." MsgBox "master data reload successfully."
End If End If
@@ -79,6 +97,11 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet)
writeRow = writeRow + 1 writeRow = writeRow + 1
Next i 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 MsgBox writeRow - cfg("StartRow") & " rows imported.", vbInformation
GoTo FinallyExit GoTo FinallyExit
@@ -94,13 +117,7 @@ End Sub
Private Sub Do_Validation(ws As Excel.Worksheet) Private Sub Do_Validation(ws As Excel.Worksheet)
On Error GoTo ErrorHandler On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' step1. confirm Validate Sub ' step1. confirm Validate Sub
Dim validate As String
validate = ws.CodeName & ".Validate"
If Not ProcedureExists(ws.CodeName, "Validate") Then If Not ProcedureExists(ws.CodeName, "Validate") Then
MsgBox "worksheet """ & ws.name & """ unimplement methods", vbExclamation MsgBox "worksheet """ & ws.name & """ unimplement methods", vbExclamation
Exit Sub Exit Sub
@@ -116,11 +133,7 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
ElseIf errorCount > 0 Then ElseIf errorCount > 0 Then
MsgBox "Validation complete. Errors: " & errorCount, vbInformation MsgBox "Validation complete. Errors: " & errorCount, vbInformation
Else Else
'There is no error RefreshCache(ws.CodeName)
Dim cacheMethodName As String: cacheMethodName = Trim(sheetConf("RefreshCacheName"))
If cacheMethodName <> "" Then
Application.Run cacheMethodName
End If
MsgBox "Validation complete. Errors: 0", vbInformation MsgBox "Validation complete. Errors: 0", vbInformation
End If End If
@@ -208,7 +221,30 @@ ExportError:
End Sub End Sub
Private Sub Do_Sort(ws As Excel.Worksheet) 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 End Sub
Private Sub Do_Filter(ws As Excel.Worksheet) Private Sub Do_Filter(ws As Excel.Worksheet)
@@ -253,7 +289,7 @@ ErrorHandler:
End Sub End Sub
' RunValidationSilent ' 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 On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -296,12 +332,18 @@ ErrorHandler:
RunValidationSilent = False RunValidationSilent = False
End Function 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 Dim VBProj As Object, VBComp As Object, CodeMod As Object
On Error Resume Next
Set VBProj = ThisWorkbook.VBProject Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents(moduleName) Set VBComp = VBProj.VBComponents(moduleName)
If Not VBComp Is Nothing Then If Not VBComp Is Nothing Then
Set CodeMod = VBComp.CodeModule Set CodeMod = VBComp.CodeModule
ProcedureExists = (CodeMod.ProcStartLine(procName, 0) > 0) ProcedureExists = (CodeMod.ProcStartLine(procName, 0) > 0)
End If End If
If Err.Number <> 0 Then ProcedureExists = False
On Error GoTo 0
End Function End Function

84
src/module/Common_Functions.bas
View File

@@ -69,35 +69,60 @@ Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
End Function 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 ' @return dict : key = keyCol，value = Array
' @param sheetName ' @param sheetName
' @param keyCol ' @param keyCol
' @param valueCols Array(4,5,6) ' @param valueCols Array(4,5,6)
' @param startRow default is 7 ' @param startRow default is 7
Function LoadLookup( _ Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Object
ByVal sheetName As String, _ On Error GoTo ErrHandler
ByVal keyCol As Long, _
ByVal valueCols As Variant, _
Optional ByVal startRow As Long = 7 _
) As Object
' --- validate --- ' --- validate ---
If Trim(sheetName) = "" Then Exit Function If Trim(sheetName) = "" Then Err.Raise 0001, "LoadLookup", "Sheet name cannot be empty."
If Not IsArray(valueCols) Then
valueCols = Array(valueCols) Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
If Not sheetConfDict.Exists(sheetName) Then
Err.Raise 1004, "LoadLookup", "Sheet not configured: " & sheetName
End If End If
Dim nValCols As Long: nValCols = UBound(valueCols) - LBound(valueCols) + 1
If nValCols = 0 Then Exit Function
' --- obtain worksheet --- ' --- obtain worksheet ---
On Error Resume Next On Error Resume Next
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(sheetName) Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(sheetName)
On Error GoTo 0 If ws Is Nothing Then Err.Raise 0003, "LoadLookup", "Worksheet named '" & sheetName & "' not found."
If ws Is Nothing Then Exit Function On Error GoTo ErrHandler
' --- obtain data（based on keyCol）--- Dim sheetConf As Object: Set sheetConf = sheetConfDict(cacheName)
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row Dim startRow As Long: startRow = sheetConf("StartRow")
If lastRow < startRow Then Exit Function 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 --- ' --- prepare col ---
Dim minCol As Long: minCol = keyCol Dim minCol As Long: minCol = keyCol
@@ -133,7 +158,6 @@ Function LoadLookup( _
Next i Next i
' --- write into --- ' --- write into ---
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare dict.CompareMode = vbTextCompare
Dim r As Long Dim r As Long
@@ -150,6 +174,10 @@ Function LoadLookup( _
Next r Next r
Set LoadLookup = dict Set LoadLookup = dict
Exit Function
ErrHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Function End Function
' obtain ' obtain
@@ -205,7 +233,6 @@ Sub ClearDataRows(ByVal ws As Worksheet)
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
'
Dim startRow As Long: startRow = sheetConf("StartRow") Dim startRow As Long: startRow = sheetConf("StartRow")
Dim startCol As String: startCol = sheetConf("StartCol") Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol") Dim endCol As String: endCol = sheetConf("EndCol")
@@ -320,8 +347,27 @@ Public Function FormatDateInput(ByVal inputStr As String) As String
End If End If
End Function 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 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 Dim errorMessage As String
If errorList.Exists(errorCode) Then If errorList.Exists(errorCode) Then
errorMessage = Replace(errorList(errorCode)(0), "{0}", param0) errorMessage = Replace(errorList(errorCode)(0), "{0}", param0)

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

36
src/sheet/C1.cls
View File

@@ -72,6 +72,10 @@ End Function
' Event Handlers ' Event Handlers
' ============================================================ ' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range) 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 Dim watchArea As Range
With Me With Me
Set watchArea = Union( _ Set watchArea = Union( _
@@ -118,7 +122,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
For Each cellG In Target For Each cellG In Target
Dim todoke As String: todoke = Trim(cellG.Value) Dim todoke As String: todoke = Trim(cellG.Value)
If todoke <> "" Then 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) Dim todokeCde As String: todokeCde = GetCode(todoke)
If z4Cache.Exists(todokeCde) Then If z4Cache.Exists(todokeCde) Then
Dim cellH As Range: Set cellH = Me.Cells(cellG.Row, 8) 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) ' Fill kukan info from M1 cache (key: kukan code, value: 7 elements)
Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long) 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 codeCol As Long: codeCol = KUKAN_CODE_COLS(idx)
Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx) Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx)
@@ -309,7 +313,7 @@ End Sub
' triggered by c clomun cshainno input ' triggered by c clomun cshainno input
Private Sub CreateAddress1Dropdown(ByVal rowNum As Long) 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 Dim empNo As String
empNo = Trim(Me.Cells(rowNum, 3).Value) empNo = Trim(Me.Cells(rowNum, 3).Value)
@@ -345,7 +349,7 @@ End Sub
' triggered by address1 select O1 cache ' triggered by address1 select O1 cache
Private Sub CreateAddress2Dropdown(ByVal rowNum As Long) 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 Dim empNo As String
empNo = Trim(Me.Cells(rowNum, 3).Value) empNo = Trim(Me.Cells(rowNum, 3).Value)
@@ -399,7 +403,7 @@ End Sub
' Create station from dropdown from M1_KukanD cache ' Create station from dropdown from M1_KukanD cache
Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long) 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) Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
If transport = "" Then Exit Sub If transport = "" Then Exit Sub
@@ -431,8 +435,8 @@ End Sub
' Create Kenshu dropdown from ' Create Kenshu dropdown from
' Structure: { D: { F: [G] } } ' Structure: { D: { F: [G] } }
Private Sub CreateKenshuDropdown(ByVal rowNum As Long, ByVal idx As Long, ByVal kukanCode As String) Private Sub CreateKenshuDropdown(ByVal rowNum As Long, ByVal idx As Long, ByVal kukanCode As String)
Dim kenshuList As Object: Set kenshuList = GetKenshuList() Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
Dim m2Cache As Object: Set m2Cache = GetM2Cache() Dim m2Cache As Object: Set m2Cache = GetCache("M2")
Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(idx) Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(idx)
Me.Cells(rowNum, ticketCol).ClearContents Me.Cells(rowNum, ticketCol).ClearContents
@@ -464,7 +468,7 @@ End Sub
' Create destination dropdown from M1_KukanD cache ' Create destination dropdown from M1_KukanD cache
' Structure: { D: { F: [G] } } ' Structure: { D: { F: [G] } }
Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) 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 transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
Dim stationFrom As String: stationFrom = GetCode(Me.Cells(rowNum, stationFromCol).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) ' 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 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 transportKbn As String: transportKbn = GetCode(Trim(Me.Cells(rowNum, transportCol).Value))
Dim stationFrom As String: stationFrom = Trim(Me.Cells(rowNum, stationFromCol).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 ' 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) 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 kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
Dim kanshuStr As String: kanshuStr = Trim(Me.Cells(rowNum, kanshuCol).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 ' validate CodeSelect
' G column [todoke Cde] ' G column [todoke Cde]
Dim ColG As String: ColG = "G" 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)) Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value))
If Not z4Cache.Exists(todokeCde) Then If Not z4Cache.Exists(todokeCde) Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColG & rowNum) 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 End If
' I column [address1 J column address2] ' 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 ColI As String: ColI = "I"
Dim ColJ As String: ColJ = "J" Dim ColJ As String: ColJ = "J"
Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ColI).Value) 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 ' validate CodeSelect
' M column [oufuku] ' M column [oufuku]
Dim ColM As String: ColM = "M" 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)) Dim oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value))
If Not oufukuList.Exists(oufukuCde) Then If Not oufukuList.Exists(oufukuCde) Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColM & rowNum) 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 ' validate CodeSelect
' N column [koutai] ' N column [koutai]
Dim ColN As String: ColN = "N" 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)) Dim koutaiCde As String: koutaiCde = GetCode(Trim(Me.Cells(rowNum, ColN).Value))
If Not koutaiList.Exists(koutaiCde) Then If Not koutaiList.Exists(koutaiCde) Then
Me.Cells(rowNum, errorCol).Value = ColN & " column is invalid" 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 End If
' validate KUKAN_CODE_COLS (S, Z, AG, AN) and related columns ' validate KUKAN_CODE_COLS (S, Z, AG, AN) and related columns
Dim m1Cache As Object: Set m1Cache = GetM1Cache() Dim m1Cache As Object: Set m1Cache = GetCache("M1")
Dim m2Cache As Object: Set m2Cache = GetM2Cache() Dim m2Cache As Object: Set m2Cache = GetCache("M2")
Dim kukanCols As Variant 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) 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 ' Create dropdown for L column
Private Sub CreateEnumDropdown(ByVal rowNum As Long) 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 ' Build dropdown list from tokubetuList
Dim dropdownList As String Dim dropdownList As String
dropdownList = "" dropdownList = ""
@@ -36,6 +36,9 @@ End Sub
' '
Private Sub Worksheet_Change(ByVal Target As Range) 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 === ' === Column C changes: Create L column dropdown ===
If Target.Column = 3 And Target.Row >= 7 Then If Target.Column = 3 And Target.Row >= 7 Then
Dim cell As Range Dim cell As Range
@@ -51,7 +54,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
' === Column D changes: Fill E column === ' === Column D changes: Fill E column ===
If Target.Column = 4 And Target.Row >= 7 Then 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 Dim cellD As Range
For Each cellD In Target For Each cellD In Target
@@ -115,7 +118,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If End If
' Check D and E column in the cache ' 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 dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
Dim eValue As String: eValue = Trim(ws.Range("E" & 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 End If
' Check L column in the tokubetuList ' 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) Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
If Not tokubetuList.Exists(lValue) Then If Not tokubetuList.Exists(lValue) Then
ws.Cells(rowNum, errorCol).Value = "L column does not exist." 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 End If
' Check if M2 uses this M1 kukan code ' 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 If Not m2Cache.Exists(cValue) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("W001", cValue) ws.Cells(rowNum, errorCol).Value = GetErrorMsg("W001", cValue)
ws.Range("C" & rowNum).Interior.Color = RGB(255, 128, 0) ws.Range("C" & rowNum).Interior.Color = RGB(255, 128, 0)

48
src/sheet/M2.cls
View File

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

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

Binary file not shown.