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

20260515指摘対応6

Browse Source
This commit is contained in:
guanxiangwei
2026-05-20 18:46:15 +09:00
parent b25db7d99c
commit 5b4ffe87aa
18 changed files with 259 additions and 185 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
src/sh/tuk/module/Common_Functions.bas
View File

@@ -42,7 +42,7 @@ Function GetCSVHeader(ByVal ws As Worksheet) As Variant
Exit Function
ErrorHandler:
Err.Raise 1005, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
Err.Raise ERR_CONFIG_INVALID, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
End Function
'
@@ -78,7 +78,7 @@ Function Contains(ByVal arr As Variant, ByVal value As String) As Boolean
Contains = False
End Function
' @return dict : key = keyCol，value = Array
' @return dict : key = keyCol, value = Array
' @param sheetName
' @param keyCol
' @param valueCols Array(4,5,6)
@@ -87,19 +87,22 @@ Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Obj
On Error GoTo ErrHandler
' --- validate ---
If Trim(sheetName) = "" Then Err.Raise 0001, "LoadLookup", "Sheet name cannot be empty."
If Trim(sheetName) = "" Then Err.Raise ERR_CONFIG_EMPTY_PARAM, "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
Err.Raise ERR_CONFIG_NOT_FOUND, "LoadLookup", "Sheet not configured: " & sheetName
End If
' --- obtain worksheet ---
Dim ws As Worksheet
On Error Resume Next
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(sheetName)
If ws Is Nothing Then Err.Raise 0003, "LoadLookup", "Worksheet named '" & sheetName & "' not found."
Set ws = ThisWorkbook.Worksheets(sheetName)
On Error GoTo ErrHandler
If ws Is Nothing Then
Err.Raise ERR_SHEET_MISSING, "LoadLookup", "Worksheet '" & sheetName & "' not found."
End If
Dim sheetConf As Object: Set sheetConf = sheetConfDict(cacheName)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim keyCol As Long: keyCol = sheetConf("KeyCol")
@@ -119,16 +122,20 @@ Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Obj
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."
If nValCols = 0 Then Err.Raise ERR_CONFIG_EMPTY_PARAM, "LoadLookup", "Value columns parameter is invalid."
' --- prepare col ---
Dim minCol As Long: minCol = keyCol
Dim maxCol As Long: maxCol = keyCol
Dim i As Long
For i = LBound(valueCols) To UBound(valueCols)
If Not IsNumeric(valueCols(i)) Then Exit Function
If Not IsNumeric(valueCols(i)) Then
Err.Raise ERR_CONFIG_INVALID, "LoadLookup", "Value column is not numeric at index " & i
End If
Dim colNum As Long: colNum = CLng(valueCols(i))
If colNum < 1 Then Exit Function
If colNum < 1 Then
Err.Raise ERR_CONFIG_INVALID, "LoadLookup", "Value column must be >= 1, got " & colNum
End If
If colNum < minCol Then minCol = colNum
If colNum > maxCol Then maxCol = colNum
Next i
@@ -203,12 +210,12 @@ Function GetLastDataRowInRange(ws As Worksheet) As Long
GetLastDataRowInRange = maxRow
Else
Err.Raise 1004, "GetLastDataRowInRange", "Sheet not configured: " & ws.CodeName
Err.Raise ERR_CONFIG_NOT_FOUND, "GetLastDataRowInRange", "Sheet not configured: " & ws.CodeName
End If
Exit Function
InvalidColumn:
Err.Raise 1005, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName
Err.Raise ERR_CONFIG_INVALID, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName
End Function
Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, ByVal rowRow As Long, Optional ByVal errorCol As Long = 2)
@@ -225,7 +232,7 @@ Sub ClearDataRows(ByVal ws As Worksheet)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
'
If Not sheetConfDict.Exists(ws.CodeName) Then
Err.Raise 1004, "ClearDataRows", "Sheet not configured: " & ws.CodeName
Err.Raise ERR_CONFIG_NOT_FOUND, "ClearDataRows", "Sheet not configured: " & ws.CodeName
End If
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)