通勤認定エクセルツール対応12 Z4からO3に変更
This commit is contained in:
@@ -48,8 +48,8 @@ Sub RefreshCache_Button()
|
||||
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("Z1", "Z2", "Z3", "T1", "T2", "T3", "O1", "O2", CACHE_O3)
|
||||
Dim sheetName As Variant
|
||||
Dim ws As Worksheet
|
||||
For Each sheetName In cacheSheets
|
||||
|
||||
@@ -8,6 +8,9 @@ Option Explicit
|
||||
' - RefreshM2Cache
|
||||
' - RefreshO1Cache
|
||||
' ============================================================
|
||||
Public Const CACHE_O3 As String = CACHE_O3
|
||||
|
||||
|
||||
Private sheetConfDict As Object
|
||||
Private FormulaCache As Object
|
||||
Public GlobalCache As Object
|
||||
@@ -381,24 +384,6 @@ Private Sub RefreshSheetDict()
|
||||
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
|
||||
Debug.Print "RefreshSheetDict Z4 ok."
|
||||
|
||||
' T1
|
||||
Set sheetConf = CreateObject("Scripting.Dictionary")
|
||||
sheetConf("StartCol") = "C"
|
||||
@@ -487,6 +472,24 @@ Private Sub RefreshSheetDict()
|
||||
Set sheetConfDict("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")
|
||||
@@ -565,7 +568,7 @@ End Function
|
||||
Public Sub RefreshMasterCache()
|
||||
' Fixed cache names
|
||||
Dim fixedCaches As Variant
|
||||
fixedCaches = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2", _
|
||||
fixedCaches = Array("Z1", "Z2", "Z3", "T1", "T2", "T3", "O1", "O2", CACHE_O3, _
|
||||
"tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
|
||||
|
||||
' Refresh fixed caches
|
||||
@@ -604,7 +607,7 @@ Public Sub WriteCachesSheet(ByVal cacheName As String)
|
||||
Case "Z1": colLetter = "A"
|
||||
Case "Z2": colLetter = "B"
|
||||
Case "Z3": colLetter = "C"
|
||||
Case "Z4": colLetter = "D"
|
||||
Case CACHE_O3: colLetter = "D"
|
||||
Case "T1": colLetter = "E"
|
||||
Case "T2": colLetter = "F"
|
||||
Case "T3": colLetter = "G"
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -816,9 +816,9 @@ 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
|
||||
|
||||
38
src/sh/tuk/sheet/O3.cls
Normal file
38
src/sh/tuk/sheet/O3.cls
Normal file
@@ -0,0 +1,38 @@
|
||||
' ============================================================
|
||||
' Module Name: Master_Z4_220
|
||||
' Module Desc: Z4 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:
|
||||
lastErrorMsg = Err.Description
|
||||
End Sub
|
||||
@@ -1,90 +0,0 @@
|
||||
' ============================================================
|
||||
' Module Name: Master_Z4_220
|
||||
' Module Desc: Z4 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
|
||||
|
||||
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
|
||||
|
||||
checkResult = CheckChar(ws, rowNum, 3, 2, errorCol)
|
||||
If checkResult = False Then Exit Sub
|
||||
|
||||
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
|
||||
Binary file not shown.
Reference in New Issue
Block a user