diff --git a/src/sh/tuk/module/Common_Button.bas b/src/sh/tuk/module/Common_Button.bas index 5ce4fe3..3b546e7 100644 --- a/src/sh/tuk/module/Common_Button.bas +++ b/src/sh/tuk/module/Common_Button.bas @@ -31,58 +31,104 @@ Sub Fit_Button() End Sub Sub RefreshCache_Button() + On Error GoTo ErrorHandler + Dim exitMsg As String Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName - - ' Determine which cache sheets to refresh based on ActiveSheet - Dim cacheSheets As Variant - If activeSheetName = "C1" Then - cacheSheets = Array("M1", "M2", "Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2") - ElseIf activeSheetName = "M1" Then - cacheSheets = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2") - ElseIf activeSheetName = "M2" Then - cacheSheets = Array("M1", "Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2") - Else - MsgBox "This sheet does not support cache refresh.", vbExclamation - Exit Sub - End If - ' Validate and refresh cache + 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") 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 + Set ws = ThisWorkbook.Worksheets(CStr(sheetName)) + Dim result As Long: result = RunValidationSilent(ws) + If result = 0 Then + Err.Raise ERR_CACHE_EMPTY, "RefreshCache_Button", sheetName & " sheet has no data." + End If + If result < 0 Then + Err.Raise ERR_CACHE_EMPTY, "RefreshCache_Button", "Can't refresh " & sheetName & " cache. Validation error occurs." End If Next sheetName + + Debug.Print "2. refresh master data" + Call RefreshMasterCache() - ' Refresh cache based on activeSheet - Dim result As Boolean: result = RefreshAllCache(activeSheetName) - If result = True Then - ' Call active sheet's Refresh method - If ProcedureExists(activeSheetName, "Refresh") Then - On Error Resume Next - Set ws = ActiveSheet - On Error GoTo 0 - If Not ws Is Nothing Then - Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() - Dim sheetConf As Object: Set sheetConf = sheetConfDict(activeSheetName) - Dim startRow As Long: startRow = sheetConf("StartRow") - Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) - Application.Run activeSheetName & ".Refresh", ws, startRow, lastDataRow - End If - Else - MsgBox "Sheet " & activeSheetName & " does not implement Refresh method.", vbExclamation - End If - - MsgBox "master data reload successfully." + Debug.Print "3. Determine which cache sheets to refresh based on ActiveSheet" + Dim refSheets As Variant + If activeSheetName = "C1" Then + ' first is M1 + Call ValidateKukanCache("M1") + Call RefreshKukanCache("M1") + Call UpdateByMaster("M1") + ' second is M2 + Call ValidateKukanCache("M2") + Call RefreshKukanCache("M2") + Call UpdateByMaster("M2") + ElseIf activeSheetName = "M2" Then + Call ValidateKukanCache("M1") + Call RefreshKukanCache("M1") + Call UpdateByMaster("M1") + End If + + Debug.Print "4. update content by other master data" + Call UpdateByMaster(activeSheetName) + + Exit Sub + +ErrorHandler: + HandleError "RefreshCache_Button" + If exitMsg <> "" Then + MsgBox "RefreshCache_Button: " & exitMsg, vbExclamation + Else + MsgBox "RefreshCache_Button: " & Err.Description, vbExclamation + End If +End Sub + +Private Sub ValidateKukanCache(ByVal sheetName As String) + On Error GoTo ErrorHandler + Dim exitMsg As String + Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CStr(sheetName)) + Dim result As Long: result = RunValidationSilent(ws) + + If result = 0 Then + exitMsg = sheetName & " sheet has no data." + GoTo ErrorHandler + End If + + If result < 0 Then + exitMsg = "Can't refresh " & sheetName & " cache. Validation error occurs." + GoTo ErrorHandler + End If + + Exit Sub + +ErrorHandler: + If exitMsg <> "" Then + MsgBox "ValidateKukanCache: " & exitMsg, vbExclamation + Else + MsgBox "ValidateKukanCache: " & Err.Description, vbExclamation + End If +End Sub + +Private Sub UpdateByMaster(ByVal sheetName As String) + On Error GoTo ErrorHandler + Dim exitMsg As String + + Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CStr(sheetName)) + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(sheetName) + Dim startRow As Long: startRow = sheetConf("StartRow") + Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) + Application.Run sheetName & ".Refresh", ws, startRow, lastDataRow + + Exit Sub + +ErrorHandler: + If exitMsg <> "" Then + MsgBox "UpdateByMaster: " & exitMsg, vbExclamation + Else + MsgBox "UpdateByMaster: " & Err.Description, vbExclamation End If End Sub @@ -149,27 +195,28 @@ End Sub ' Private Sub Do_Validation(ws As Excel.Worksheet) On Error GoTo ErrorHandler + Dim exitMsg As String - ' step1. confirm Validate Sub - If Not ProcedureExists(ws.CodeName, "Validate") Then - MsgBox "worksheet """ & ws.name & """ unimplement methods", vbExclamation - Exit Sub - End If - - Dim errorCount As Long - Dim isValid As Boolean: isValid = RunValidationSilent(ws, errorCount) - - If errorCount = -1 Then - MsgBox "worksheet """ & ws.Name & """ unimplement methods", vbExclamation - ElseIf errorCount = -2 Then - MsgBox "Validation error occurred.", vbCritical - ElseIf errorCount > 0 Then - MsgBox "Validation complete. Errors: " & errorCount, vbInformation + Dim result As Long: result = RunValidationSilent(ws) + + If result = -1 Then + exitMsg = "Validation has errors." + GoTo ErrorHandler + ElseIf result = 0 Then + exitMsg = "No data to validate." + GoTo ErrorHandler Else If ws.CodeName <> "C1" Then RefreshCache(ws.CodeName) + WriteCachesSheet(ws.CodeName) End If - MsgBox "Validation complete. Errors: 0", vbInformation + MsgBox "Validation complete. Success: " & result, vbInformation + End If + + ' step2. ValidateWarn for M1 sheet + If ws.CodeName = "M1" Then + Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) + Application.Run "M1.ValidateWarn", ws, lastDataRow End If Do_Fit ws @@ -177,43 +224,41 @@ Private Sub Do_Validation(ws As Excel.Worksheet) Exit Sub ErrorHandler: - MsgBox "Error: " & Err.Description, vbCritical - Exit Sub + HandleError "Do_Validation" + ' If exitMsg <> "" Then + ' MsgBox "Do_Validation: " & exitMsg, vbExclamation + ' Else + ' MsgBox "Do_Validation: " & Err.Description, vbExclamation + ' End If End Sub ' Private Sub DO_CSV_Export(ws As Excel.Worksheet) On Error GoTo ExportError - Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() - Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + ' === Step 1: Validate all rows before export === + Dim result As Long: result = RunValidationSilent(ws) - Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) - Dim startRow As Long: startRow = sheetConf("StartRow") - - If lastDataRow < startRow Then + If result = 0 Then MsgBox "No data rows to output.", vbExclamation Exit Sub End If - ' === Step 1: Validate all rows before export === - ' Do_Validation - Dim errorCount As Long - If Not RunValidationSilent(ws, errorCount) Then - If errorCount > 0 Then - MsgBox "Validation failed (" & errorCount & " errors). Export aborted.", vbCritical - Exit Sub - Else - MsgBox "Validation setup error. Export aborted.", vbCritical - Exit Sub - End If + If result < 0 Then + MsgBox "Validation failed. Export aborted.", vbCritical + Exit Sub End If ' === Step 2: Select save path === Dim savePath As String: savePath = GetSaveCSVPath() If savePath = "" Then Exit Sub - + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + ' === Step 3: Count data rows === + Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) + Dim startRow As Long: startRow = sheetConf("StartRow") Dim rowCount As Long: rowCount = lastDataRow - startRow + 1 ' === Step 4: Count data columns === @@ -333,61 +378,50 @@ ErrorHandler: End Sub ' RunValidationSilent -Public Function RunValidationSilent(ws As Worksheet, Optional ByRef errorCountOut As Long = 0) As Boolean - On Error GoTo ErrorHandler - +' Positive number = success (number of rows with no errors) +' 0 = no data +' -1 = has errors +' -2 = runtime error +Public Function RunValidationSilent(ws As Worksheet) As Long Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) - ' check Validate method exist - If Not ProcedureExists(ws.CodeName, "Validate") Then - errorCountOut = -1 - RunValidationSilent = False - Exit Function - End If - Dim validate As String: validate = ws.CodeName & ".Validate" Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) Dim startRow As Long: startRow = sheetConf("StartRow") Dim errorCol As Long: errorCol = ws.Range(sheetConf("ErrorCol") & "1").Column If lastDataRow < startRow Then - errorCountOut = 0 - RunValidationSilent = True + RunValidationSilent = 0 Exit Function End If Dim r As Long - errorCountOut = 0 + Dim hasError As Boolean: hasError = False For r = startRow To lastDataRow Application.Run validate, ws, r, lastDataRow Dim errorMessage As String : errorMessage = Trim(ws.Cells(r, errorCol).Value) Dim errorCode As String: errorCode = GetCode(errorMessage) If errorCode <> "W001" And errorCode <> "" Then - errorCountOut = errorCountOut + 1 + hasError = True End If Next r - RunValidationSilent = (errorCountOut = 0) - Exit Function - -ErrorHandler: - errorCountOut = -2 - RunValidationSilent = False -End Function - -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) + If hasError = True Then + RunValidationSilent = -1 + Exit Function End If - If Err.Number <> 0 Then ProcedureExists = False - On Error GoTo 0 -End Function \ No newline at end of file + RunValidationSilent = lastDataRow - startRow + 1 + Exit Function +End Function + +Public Sub HandleError(sourceProcedure As String) + Dim msg As String + + Select Case Err.Number + Case ERR_CACHE_EMPTY + msg = Err.Description + MsgBox msg, vbExclamation + End Select +End Sub diff --git a/src/sh/tuk/module/Common_Constants.bas b/src/sh/tuk/module/Common_Constants.bas new file mode 100644 index 0000000..6981006 --- /dev/null +++ b/src/sh/tuk/module/Common_Constants.bas @@ -0,0 +1,10 @@ +Attribute VB_Name = "Common_Constants" +Option Explicit +' ============================================================ +' Module Name: Common_Constants +' Module Desc: Common_Constants +' Module Methods: +' ============================================================ +Public Const ERR_CACHE_NOT_FOUND As Long = vbObjectError + 1001 +Public Const ERR_CACHE_EMPTY As Long = vbObjectError + 1002 +Public Const ERR_VALIDATION_FAILED As Long = vbObjectError + 1003 \ No newline at end of file diff --git a/src/sh/tuk/module/Common_Global_Cache.bas b/src/sh/tuk/module/Common_Global_Cache.bas index f252071..125d47d 100644 --- a/src/sh/tuk/module/Common_Global_Cache.bas +++ b/src/sh/tuk/module/Common_Global_Cache.bas @@ -9,7 +9,7 @@ Option Explicit ' - RefreshO1Cache ' ============================================================ Private sheetConfDict As Object - +Private FormulaCache As Object Public GlobalCache As Object Public Sub InitCacheManager() @@ -20,65 +20,33 @@ Public Sub InitCacheManager() End Sub Public Function GetCache(ByVal cacheName As String) As Object - Dim cache As Object - Dim loadedData As Object - - ' - On Error GoTo RefreshError - - ' If GlobalCache Is Nothing Then InitCacheManager - - ' If Not GlobalCache.Exists(cacheName) Then Set GlobalCache(cacheName) = CreateObject("Scripting.Dictionary") GlobalCache(cacheName).CompareMode = vbTextCompare End If + Dim cache As Object Set cache = GlobalCache(cacheName) - Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() If cache.Count = 0 Then - If cacheName = "M1KukanDCache" Then - Set loadedData = LookupM1KukanCache() - ElseIf cacheName = "M2" Then - Set loadedData = LookupM2Cache() - ElseIf cacheName = "O1" Then - Set loadedData = LookupO1Cache() - ElseIf Contains(sheetConfDict("Enum"), cacheName) Then - Set loadedData = LoadLookup("Enum", cacheName) - Else - Set loadedData = LoadLookup(cacheName, cacheName) - End If - - If Not loadedData Is Nothing Then - Set GlobalCache(cacheName) = loadedData - Set cache = loadedData - End If + Err.Raise 1001, "GetCache", "No cached data found for '" & cacheName & "'. Please load the cache first." End If Set GetCache = cache Exit Function - -RefreshError: - Err.Raise 1001, "GetCache", "Failed to load " & cacheName & " lookup cache: " & Err.Description End Function ' before RefreshCache, should validate Public Sub RefreshCache(ByVal cacheName As String) - Dim loadedData As Object - - ' On Error GoTo RefreshError - ' If GlobalCache Is Nothing Then InitCacheManager - - ' If Not GlobalCache.Exists(cacheName) Then Set GlobalCache(cacheName) = CreateObject("Scripting.Dictionary") GlobalCache(cacheName).CompareMode = vbTextCompare End If + Dim loadedData As Object Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() If cacheName = "M1KukanDCache" Then Set loadedData = LookupM1KukanCache() @@ -573,6 +541,12 @@ Private Sub RefreshSheetDict() Set sheetConfDict("errorList") = sheetConf Debug.Print "RefreshSheetDict errorList ok." + ' Caches + Set sheetConf = CreateObject("Scripting.Dictionary") + ' TODO + Set sheetConfDict("Caches") = sheetConf + Debug.Print "RefreshSheetDict Caches ok." + Debug.Print "RefreshSheetDict end." End Sub @@ -581,32 +555,93 @@ Public Function GetSheetConfig() As Object Set GetSheetConfig = sheetConfDict End Function -Public Function RefreshAllCache(Optional ByVal activeSheetName As String = "") As Boolean +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") - ' Dynamic cache names based on activeSheet - Dim dynamicCaches As Variant - If activeSheetName = "C1" Then - dynamicCaches = Array("M1", "M1KukanDCache", "M2") - ElseIf activeSheetName = "M2" Then - dynamicCaches = Array("M1", "M1KukanDCache") - Else - dynamicCaches = Array() - End If - ' Refresh fixed caches Dim cacheName As Variant For Each cacheName In fixedCaches Call RefreshCache(CStr(cacheName)) + Call WriteCachesSheet(CStr(cacheName)) Next cacheName +End Sub + +Public Sub RefreshKukanCache(ByVal sheetName As String) + If sheetName = "M1" Then + Call RefreshCache("M1") + Call RefreshCache("M1KukanDCache") + Call WriteCachesSheet("M1") + End If + If sheetName = "M2" Then + Call RefreshCache("M2") + Call WriteCachesSheet("M2") + End If +End Sub + +' Write cache data to Caches sheet for dropdown +Public Sub WriteCachesSheet(ByVal cacheName As String) + Dim wsCache As Worksheet + Set wsCache = ThisWorkbook.Sheets("Caches") + If wsCache Is Nothing Then + Set wsCache = ThisWorkbook.Sheets.Add + wsCache.Name = "Caches" + wsCache.Visible = xlVeryHidden + End If - ' Refresh dynamic caches - For Each cacheName In dynamicCaches - Call RefreshCache(CStr(cacheName)) - Next cacheName + ' 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 "O1": colLetter = "H" + Case "O2": colLetter = "I" + Case Else: Exit Sub + End Select - RefreshAllCache = True -End Function \ No newline at end of file + Dim cache As Object: Set cache = GetCache(cacheName) + If cache Is Nothing Then Exit Sub + + ' Write to Caches sheet + wsCache.Columns(colLetter).ClearContents + Dim idx As Long: idx = 1 + Dim key As Variant + For Each key In cache.Keys + If key <> 0 Then + Dim displayText As String: displayText = MakeSelect(key, cache(key)(0)) + If displayText <> "" Then + wsCache.Cells(idx, colLetter).Value = displayText + idx = idx + 1 + End If + End If + Next key + + Dim lastRow As Long: lastRow = wsCache.Cells(wsCache.Rows.Count, colLetter).End(xlUp).Row + + Dim formulaStr As String + If lastRow >= 1 Then + formulaStr = "=Caches!" & colLetter & "1:" & colLetter & lastRow + Else + formulaStr = "=Caches!" & colLetter & "1" + End If + + ' write into FormulaCache + If FormulaCache Is Nothing Then Set FormulaCache = CreateObject("Scripting.Dictionary") + FormulaCache(cacheName) = formulaStr +End Sub + +Public Function GetValidationFormula(ByVal cacheName As String) As String + If FormulaCache Is Nothing Then Set FormulaCache = CreateObject("Scripting.Dictionary") + If FormulaCache.Exists(cacheName) Then + GetValidationFormula = FormulaCache(cacheName) + Else + GetValidationFormula = "" + End If +End Function diff --git a/src/sh/tuk/module/Common_Selector.bas b/src/sh/tuk/module/Common_Selector.bas index ce47a06..6014791 100644 --- a/src/sh/tuk/module/Common_Selector.bas +++ b/src/sh/tuk/module/Common_Selector.bas @@ -191,7 +191,7 @@ Public Sub BuildKenshuDropdown(ws As Worksheet, ByVal columnLetter As String, By End With End Sub -' Create Kenshu dropdown (exclude key = 0) +' Create Tokubetu dropdown Public Sub BuildTokubetuDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long) Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList") Dim dropdownList As String: dropdownList = "" @@ -212,4 +212,40 @@ Public Sub BuildTokubetuDropdown(ws As Worksheet, ByVal columnLetter As String, .InputTitle = "" .InputMessage = "" End With -End Sub \ No newline at end of file +End Sub + +' Create Renraku dropdown +Public Sub BuildRenrakuDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long) + Dim renrakuList As Object: Set renrakuList = GetCache("renrakuList") + Dim dropdownList As String: dropdownList = "" + Dim key As Variant + For Each key In renrakuList.Keys + If dropdownList = "" Then + dropdownList = key + Else + dropdownList = dropdownList & "," & key + End If + Next key + + With ws.Range(columnLetter & 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) + If formula = "" Then Exit Sub + + With ws.Range(columnLetter & rowNum).Validation + .Delete + .Add Type:=xlValidateList, Formula1:=formula + .IgnoreBlank = True + .InCellDropdown = True + End With +End Sub diff --git a/src/sh/tuk/sheet/M1.cls b/src/sh/tuk/sheet/M1.cls index 14f7cfd..6d21ed7 100644 --- a/src/sh/tuk/sheet/M1.cls +++ b/src/sh/tuk/sheet/M1.cls @@ -20,6 +20,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) Call ClearDataRow(Me, START_COL + 1, END_COL, cell.Row, ERROR_COL) Else Call BuildTokubetuDropdown(Me, "L", cell.Row) + Call BuildRenrakuDropdown(Me, "K", cell.Row) End If Next End If @@ -126,14 +127,6 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Exit Sub End If - ' Check if M2 uses this M1 kukan code - 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) - Exit Sub - End If - ' Validation passed - clear error ws.Cells(rowNum, errorCol).ClearContents End Sub @@ -157,4 +150,59 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A Finally: Application.EnableEvents = True +End Sub + +Private Sub ValidateWarn(ws As Worksheet, ByVal lastDataRow As Long) + On Error GoTo ErrorHandler + Dim exitMsg As String + + ' Get M2 sheet kukan code list directly + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim m2SheetConf As Object: Set m2SheetConf = sheetConfDict("M2") + Dim m2StartRow As Long: m2StartRow = m2SheetConf("StartRow") + Dim wsM2 As Worksheet: Set wsM2 = ThisWorkbook.Worksheets("M2") + Dim lastRowM2 As Long: lastRowM2 = GetLastDataRowInRange(wsM2) + If lastRowM2 < m2StartRow Then + exitMsg = "M2 sheet has no data" + GoTo ErrorHandler + End If + + ' Build kukan code list from M2 sheet + Dim kukanList As Object: Set kukanList = CreateObject("Scripting.Dictionary") + Dim r As Long + For r = m2StartRow To lastRowM2 + Dim kukanCode As String: kukanCode = Trim(wsM2.Cells(r, 3).Value) + If kukanCode <> "" And Not kukanList.Exists(kukanCode) Then + kukanList.Add kukanCode, True + End If + Next r + + + Dim sheetConf As Object: Set sheetConf = sheetConfDict("M1") + Dim startRow As Long: startRow = sheetConf("StartRow") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") + ' Check all rows in M1 sheet + If lastDataRow < startRow Then + exitMsg = "M1 sheet has no data" + GoTo ErrorHandler + End If + + Dim rowNum As Long + For rowNum = startRow To lastDataRow + Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value) + If Not kukanList.Exists(cValue) Then + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("W001", cValue) + ws.Range("C" & rowNum).Interior.Color = RGB(255, 128, 0) + End If +NextRow: + Next rowNum + + Exit Sub + +ErrorHandler: + If exitMsg <> "" Then + MsgBox "ValidateWarn: " & exitMsg, vbExclamation + Else + MsgBox "ValidateWarn: " & Err.Description, vbExclamation + End If End Sub \ No newline at end of file diff --git a/src/sh/tuk/sheet/M2.cls b/src/sh/tuk/sheet/M2.cls index fc5557e..81b2191 100644 --- a/src/sh/tuk/sheet/M2.cls +++ b/src/sh/tuk/sheet/M2.cls @@ -175,25 +175,7 @@ Private Sub CreateJDropdown(ByVal rowNum As Long) If cache Is Nothing Then Exit Sub - ' Build dropdown list from cache - Dim dropdownList As String: dropdownList = "" - Dim key As Variant - For Each key In cache.Keys - Dim displayText As String: displayText = MakeSelect(key, cache(key)(0)) - If dropdownList = "" Then - dropdownList = displayText - Else - dropdownList = dropdownList & "," & displayText - End If - Next key - - If dropdownList <> "" Then - With targetCell.Validation - .Add Type:=xlValidateList, Formula1:=dropdownList - .IgnoreBlank = True - .InCellDropdown = True - End With - End If + Call BuildDropdownFromCacheNamedRange(Me, "J", rowNum, "T" & iValue) End Sub Private Sub FillFromM1(ByVal ws As Worksheet, ByVal rowNum As Long) diff --git a/src/sh/tuk/sheet/O1.cls b/src/sh/tuk/sheet/O1.cls index 978bace..7ccc10d 100644 --- a/src/sh/tuk/sheet/O1.cls +++ b/src/sh/tuk/sheet/O1.cls @@ -11,5 +11,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target) If HasHeaderEdit = True Then Exit Sub +End Sub -End Sub \ No newline at end of file +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) +End Sub diff --git a/src/sh/tuk/sheet/O2.cls b/src/sh/tuk/sheet/O2.cls index b832311..01c74e8 100644 --- a/src/sh/tuk/sheet/O2.cls +++ b/src/sh/tuk/sheet/O2.cls @@ -13,3 +13,6 @@ Private Sub Worksheet_Change(ByVal Target As Range) If HasHeaderEdit = True Then Exit Sub End Sub + +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) +End Sub \ No newline at end of file diff --git a/通勤手当テンプレート20260515.xlsm b/通勤手当テンプレート20260515.xlsm index d591d8f..36de47d 100644 Binary files a/通勤手当テンプレート20260515.xlsm and b/通勤手当テンプレート20260515.xlsm differ