20260515指摘対応8

2026-05-21 16:02:08 +09:00
parent bee1cd9810
commit 0a633d711c
6 changed files with 315 additions and 252 deletions
--- a/src/sh/tuk/module/Common_Functions.bas
+++ b/src/sh/tuk/module/Common_Functions.bas
@@ -45,7 +45,7 @@ ErrorHandler:
    Err.Raise ERR_CONFIG_INVALID, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
 End Function

-'
+' Clean CSV field: add quote prefix for formula-like values
 Function CleanCSVField(ByVal inputStr As String) As String
    Dim s As String
    s = Trim(inputStr)
@@ -62,10 +62,12 @@ Function CleanCSVField(ByVal inputStr As String) As String
    CleanCSVField = s
 End Function

+' Get last data row in specified column
 Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
    GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
 End Function

+' Check if array contains value
 Function Contains(ByVal arr As Variant, ByVal value As String) As Boolean
    Dim i As Long
    For i = 0 To UBound(arr)
@@ -184,7 +186,7 @@ ErrHandler:
    Err.Raise Err.Number, Err.Source, Err.Description
 End Function

-' obtain
+' Get last data row in specified column
 Function GetLastDataRowInRange(ws As Worksheet) As Long

    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -218,6 +220,7 @@ InvalidColumn:
    Err.Raise ERR_CONFIG_INVALID, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName
 End Function

+'Clear single row data and format
 Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, ByVal rowRow As Long, Optional ByVal errorCol As Long = 2)
    If rowRow >= 7 Then
        Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowRow, startCol), ws.Cells(rowRow, endCol))
@@ -227,8 +230,9 @@ Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCo
    End If
 End Function

+'Clear all data rows from startRow to lastDataRow
 Sub ClearDataRows(ByVal ws As Worksheet)
-    ' 
+    ' Clear data and format from startRow to lastDataRow
    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    ' 
    If Not sheetConfDict.Exists(ws.CodeName) Then
@@ -241,10 +245,9 @@ Sub ClearDataRows(ByVal ws As Worksheet)
    Dim startCol As String: startCol = sheetConf("StartCol")
    Dim endCol As String: endCol = sheetConf("EndCol")
    Dim errorCol As String: errorCol = sheetConf("ErrorCol")
-    '
+
+    Application.EnableEvents = False
    Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
-    
-    '
    If lastDataRow >= startRow Then
        Dim clearRange As Range
        Set clearRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column))
@@ -258,9 +261,52 @@ Sub ClearDataRows(ByVal ws As Worksheet)
          clearErrorRange.Interior.Color = vbWhite
        End If
    End If
+    
+    ' Clear formats below lastDataRow (including dropdowns)
+    Application.EnableEvents = True
+    Call ClearFormatsBelowLastDataRow(ws)
 End Sub

-' Format: code:value (no space around colon)
+'Clear formats below lastDataRow
+Sub ClearFormatsBelowLastDataRow(ws As Worksheet)
+    On Error GoTo ErrorHandler
+    Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
+    
+    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
+    
+    Dim startCol As Long, endCol As Long
+    startCol = ws.Range(sheetConf("ErrorCol") & "1").Column
+    endCol = ws.Range(sheetConf("EndCol") & "1").Column
+
+    If lastRow >= ws.Rows.Count Then Exit Sub
+
+    Dim clearRange As Range
+    Set clearRange = ws.Range( _
+        ws.Cells(lastRow + 1, startCol), _
+        ws.Cells(ws.Rows.Count, endCol) _
+    )
+
+    Application.EnableEvents = False
+    clearRange.ClearContents
+    clearRange.Interior.Color = vbWhite
+    clearRange.Validation.Delete
+    Application.EnableEvents = True
+
+ErrorHandler:
+    Application.EnableEvents = True
+End Sub
+
+' Check if text starts with prefix
+Function StartsWith(text As String, prefix As String) As Boolean
+    If Len(text) < Len(prefix) Then
+        StartsWith = False
+    Else
+        StartsWith = (Left(text, Len(prefix)) = prefix)
+    End If
+End Function
+
+' Make select format: code:value
 Function MakeSelect(ByVal code As String, ByVal value As String) As String
    MakeSelect = Trim(code) & ":" & Trim(value)
 End Function
@@ -316,16 +362,16 @@ Public Function FormatDateInput(ByVal inputStr As String) As String
    End If
 End Function

+'Check header edit protection
 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")
    Dim filterRow As Long: filterRow = sheetConf("FilterRow")

    ' Check header row (headerRow) cannot be edited
    Dim r As Long
    For r = Target.Row To Target.Row + Target.Rows.Count - 1
-        If r = headerRow Or r = filterRow Then
+        If r = 1 Or r = filterRow Then
            Application.EnableEvents = False
            MsgBox "Header or type definition row cannot be edited.", vbExclamation
            Application.Undo
@@ -355,6 +401,7 @@ Function CheckHeaderEdit(ByVal ws As Worksheet, ByVal Target As Range) As Boolea
    CheckHeaderEdit = False
 End Function

+'Get error message by code
 Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String = "", Optional ByVal param1 As String = "") As String
    Dim errorList As Object: Set errorList = GetCache("errorList")
    Dim errorMessage As String
@@ -366,10 +413,12 @@ Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String
    GetErrorMsg = errorMessage
 End Function

+'Convert column number to letter
 Function ColLetter(colNum As Long) As String
    ColLetter = Split(Cells(1, colNum).Address, "$")(1)
 End Function

+'Check required field is not empty
 Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If checkValue = "" Then
@@ -382,6 +431,7 @@ Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum
    CheckRequired = True
 End Function

+'Check character length
 Function CheckChar(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If Len(checkValue) <> charLength Then
@@ -394,6 +444,7 @@ Function CheckChar(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As
    CheckChar = True
 End Function

+'Check alphanumeric characters
 Function CheckAlphanumeric(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
@@ -412,6 +463,7 @@ Function CheckAlphanumeric(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal co
    CheckAlphanumeric = True
 End Function

+'Check varchar length overflow
 Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal varcharLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If Len(checkValue) > varcharLength Then
@@ -424,6 +476,7 @@ Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal col
    CheckVarcharOver = True
 End Function

+'Check number length overflow
 Function CheckNumberOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal numberLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If Len(checkValue) > numberLength Then
@@ -436,6 +489,7 @@ Function CheckNumberOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colN
    CheckNumberOver = True
 End Function

+'Check value is 0 or 1
 Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
@@ -456,6 +510,7 @@ Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Lo
    Check01 = True
 End Function

+'Check value is 1 or 2
 Function Check12(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
@@ -476,6 +531,7 @@ Function Check12(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Lo
    Check12 = True
 End Function

+'Check duplicate value in column
 Function CheckDuplicate(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
@@ -493,6 +549,7 @@ Function CheckDuplicate(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNu
    CheckDuplicate = True
 End Function

+'Check numeric value
 Function CheckNumber(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)