update C1

This commit is contained in:
simple321vip
2026-04-19 23:42:57 +08:00
parent de3f513230
commit 7f271043b7
5 changed files with 243 additions and 46 deletions

View File

@@ -319,3 +319,7 @@ Public Function FormatDateInput(ByVal inputStr As String) As String
FormatDateInput = inputStr
End If
End Function
Function ColNumToLetter(colNum As Long) As String
ColNumToLetter = Split(Cells(1, colNum).Address, "$")(1)
End Function

View File

@@ -381,6 +381,24 @@ Private Sub RefreshSheetDict()
Set sheetConfDict = CreateObject("Scripting.Dictionary")
Dim sheetConf As Object
' C1
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "BC"
sheetConf("ErrorCol") = "BD"
sheetConf("StartRow") = 8
sheetConf("HeaderRow") = 6
sheetConf("RefreshCacheName") = ""
sheetConf("CSV_Encoding") = "shift_jis"
sheetConf("HasHeader") = True
sheetConf("ExpectedColumnCount") = 54
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
sheetConf("AlwaysQuote") = False
sheetConf("FilterRow") = 7
Set sheetConfDict("C1") = sheetConf
' M1
Set sheetConf = CreateObject("Scripting.Dictionary")
@@ -495,15 +513,15 @@ Private Sub RefreshSheetDict()
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "F"
sheetConf("ErrorCol") = ""
sheetConf("StartRow") = 7
sheetConf("StartRow") = 6
sheetConf("HeaderRow") = ""
sheetConf("RefreshCacheName") = "RefreshO1Cache"
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("ExpectedColumnCount") = 4
sheetConf("HeaderColumns") = Array()
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("FilterRow") = 5
Set sheetConfDict("O1") = sheetConf
@@ -513,15 +531,15 @@ Private Sub RefreshSheetDict()
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "O"
sheetConf("ErrorCol") = ""
sheetConf("StartRow") = 7
sheetConf("StartRow") = 6
sheetConf("HeaderRow") = ""
sheetConf("RefreshCacheName") = "RefreshO2Cache"
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("ExpectedColumnCount") = 13
sheetConf("HeaderColumns") = Array()
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("FilterRow") = 5
Set sheetConfDict("O2") = sheetConf
End Sub

View File

@@ -9,32 +9,12 @@
' - FillKukanFromM1
' - FillKanshuFromM2
' - FillCodeFromM2
' - FillAddressFromO1
' - CreateAddress1Dropdown
' - FillZ1Dropdown
' ============================================================
' ====== (Tukin_C1) =======
' Commuter allowance editing sheet
' No CSV import - direct editing only
' ====== Constants ======
Const START_COL As Long = 3 ' C column (职员番号)
Const END_COL As Long = 56 ' BC column
Const ERROR_COL As Long = 57 ' BD column
Const Tukin_HEADER_ROW As Long = 6
' Column regions (for reference)
' D-H: 届出情報 (cols 4-8)
' I-J: 住所情報 (cols 9-10)
' K-O: 出勤情報 (cols 11-15)
' P-R: 自動車等情報 (cols 16-18)
' S-Y: 区間1情報 (cols 19-25)
' Z-AF: 区間2情報 (cols 26-32)
' AG-AM: 区間3情報 (cols 33-39)
' AN-AT: 区間4情報 (cols 40-46)
' AU-AX: 決定事項情報 (cols 47-50)
' AY-BA: 備考情報 (cols 51-53)
' BB-BC: 認定情報 (cols 54-56)
' ============================================================
' Column arrays for 4 kukan sections
' ============================================================
@@ -67,7 +47,11 @@ Private Function KUKAN_START_DAY_COLS() As Variant
End Function
Private Function DATE_COLS() As Variant
DATE_COLS = Array(4, 5, 6, 25, 32, 39, 46, 54) ' D, E, F, Y, AF, AM, AT, BB
DATE_COLS = Array(4, 5, 6, 25, 32, 39, 46, 51, 54) ' D, E, F, Y, AF, AM, AT, AY, BB
End Function
Private Function NUMBER_COLS() As Variant
NUMBER_COLS = Array("L", "P", "Q", "R")
End Function
' ============================================================
@@ -123,10 +107,34 @@ Private Sub Worksheet_Change(ByVal Target As Range)
If Trim(cell.Value) = "" Then
Call ClearRowData(cell.Row)
Else
Call FillAddressFromO1(cell.Row)
Call CreateAddress1Dropdown(cell.Row)
End If
Next
End If
' auto fill G column [todoke biko]
If Target.Column = 7 Then
Dim cellG As Range
For Each cellG In Target
Dim todoke As String: todoke = Trim(cellG.Value)
If todoke <> "" Then
Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
Dim todokeCde As String: todokeCde = GetCode(todoke)
If z4Cache.Exists(todokeCde) Then
Dim cellH As Range: Set cellH = Me.Cells(cellG.Row, 8)
cellH.Value = z4Cache(todokeCde)(0)
End If
End If
Next
End If
' === Column I changes ===
If Target.Column = 9 Then
Dim cellI As Range
For Each cellI In Target
Call CreateAddress2Dropdown(cellI.Row)
Next
End If
' === Date columns changes ===
idx = GetIdx(Target.Column, DATE_COLS)
@@ -134,7 +142,14 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellDate As Range
For Each cellDate In Target
If Trim(cellDate.Value) <> "" Then
cellDate.Value = FormatDateInput(cellDate.Value)
Dim formattedDate As String: formattedDate = FormatDateInput(cellDate.Value)
cellDate.Value = FormatDateInput(formattedDate)
If cellDate.Column = 5 Then
Dim fCell As Range: Set fCell = Me.Cells(cellDate.Row, 6)
If Trim(fCell.Value) = "" Then
fCell.Value = formattedDate
End If
End If
End If
Next
End If
@@ -291,8 +306,8 @@ Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long)
End If
End Sub
' Fill address dropdown from O1 cache
Private Sub FillAddressFromO1(ByVal rowNum As Long)
' triggered by c clomun cshainno input
Private Sub CreateAddress1Dropdown(ByVal rowNum As Long)
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
Dim empNo As String
@@ -314,7 +329,7 @@ Private Sub FillAddressFromO1(ByVal rowNum As Long)
Next eKey
End If
' Create dropdown for I column ()
' Create dropdown for I column address1
If dropdownList <> "" Then
With Me.Range("I" & rowNum).Validation
.Delete
@@ -327,7 +342,61 @@ Private Sub FillAddressFromO1(ByVal rowNum As Long)
End If
End Sub
' Create station () dropdown from M1_KukanD cache
' triggered by address1 select O1 cache
Private Sub CreateAddress2Dropdown(ByVal rowNum As Long)
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
Dim empNo As String
empNo = Trim(Me.Cells(rowNum, 3).Value)
If empNo = "" Then
Me.Range("J" & rowNum).Validation.Delete
Me.Range("J" & rowNum).Value = ""
Exit Sub
End If
Dim addr1 As String
addr1 = Trim(Me.Cells(rowNum, 9).Value)
Me.Range("J" & rowNum).Value = ""
If addr1 = "" Then
Me.Range("J" & rowNum).Validation.Delete
Exit Sub
End If
' Build dropdown list from O1 cache
Dim dropdownList As String
If o1Cache.Exists(empNo) Then
Dim innerDict As Object
Set innerDict = o1Cache(empNo)
If innerDict.Exists(addr1) Then
Dim addr2Dict As Object
Set addr2Dict = innerDict(addr1)
Dim addr2Key As Variant
For Each addr2Key In addr2Dict.Keys
If dropdownList = "" Then
dropdownList = addr2Key
Else
dropdownList = dropdownList & "," & addr2Key
End If
Next addr2Key
End If
End If
' Create dropdown for J column
If dropdownList <> "" Then
With Me.Range("J" & rowNum).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
End With
End If
End Sub
' Create station from dropdown from M1_KukanD cache
Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long)
Dim m1KukanDCache As Object: Set m1KukanDCache = GetM1KukanDCache()
@@ -358,7 +427,7 @@ Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol A
End If
End Sub
' Create destination (利用区間着) dropdown from M1_KukanD cache
' Create destination dropdown from M1_KukanD cache
' Structure: { D: { F: [G] } }
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()
@@ -410,7 +479,7 @@ Private Function FindKukanCodeByStation(ByVal rowNum As Long, ByVal transportCol
Dim code As Variant
For Each code In m1Cache.Keys
Dim vals As Variant: vals = m1Cache(code)
' vals(1) = D(), vals(3) = F(), vals(4) = G()
' vals(1) = D, vals(3) = F, vals(4) = G
If vals(1) = transportKbn And vals(3) = stationFrom And vals(4) = stationTo Then
FindKukanCodeByStation = code
Exit Function
@@ -425,7 +494,7 @@ Private Sub ClearKukanValidation(ByVal rowNum As Long, ByVal col As Long)
Me.Cells(rowNum, col).Validation.Delete
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)
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
@@ -459,10 +528,25 @@ Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Lon
End With
End If
End Sub
' Clear row data
' Clear row data and validation
Private Sub ClearRowData(ByVal rowNum As Long)
Me.Range(Me.Cells(rowNum, 4), Me.Cells(rowNum, END_COL)).ClearContents
Me.Cells(rowNum, ERROR_COL).ClearContents
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")
Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).ClearContents
Me.Cells(rowNum, errorCol).ClearContents
Dim clearValidationCols As Variant
clearValidationCols = Array("I", "J", "U", "V", "X", "AB", "AC", "AE", "AI", "AJ", "AL", "AP", "AQ", "AS")
Dim col As Variant
For Each col In clearValidationCols
Me.Range(col & rowNum).Validation.Delete
Next col
End Sub
' Validation logic
@@ -480,15 +564,106 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' Required columns: C-G, K-N, AW
Dim requiredCols As Variant
requiredCols = Array("C", "D", "E", "F", "G", "K", "L", "M", "N", "AW")
requiredCols = Array("C", "D", "E", "F", "G", "L", "M", "N", "AW")
Dim col As Variant
For Each col In requiredCols
If Trim(Me.Range(col & rowNum).Value & "") = "" Then
Me.Cells(rowNum, ERROR_COL).Value = col & " column is required"
Me.Cells(rowNum, errorCol).Value = col & " column is required"
Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next col
Me.Cells(rowNum, ERROR_COL).ClearContents
' validate date
Dim colIndex As Variant
For Each colIndex In DATE_COLS()
Dim cellDate As String: cellDate = Trim(Me.Cells(rowNum, colIndex).Value)
If cellDate <> "" And Not IsDate(cellDate) Then
Dim letter As String: letter = Split(Me.Cells(1, colIndex).Address, "$")(1)
Me.Cells(rowNum, errorCol).Value = letter & " column is invalid"
Me.Range(letter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next colIndex
' validate number
For Each col In NUMBER_COLS()
Dim cellNumber As String: cellNumber = Trim(Me.Cells(rowNum, col).Value)
If cellNumber <> "" And Not IsNumeric(cellNumber) Then
Me.Cells(rowNum, errorCol).Value = col & " column is invalid"
Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next col
' validate CodeSelect
' G column [todoke Cde]
Dim ColG As String: ColG = "G"
Dim todoke As String: todoke = Trim(Me.Cells(rowNum, ColG).Value)
If todoke <> "" Then
Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
Dim todokeCde As String: todokeCde = GetCode(todoke)
If Not z4Cache.Exists(todokeCde) Then
Me.Cells(rowNum, errorCol).Value = ColG & " column is invalid"
Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
' I column [address1 J column address2]
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
Dim ColI As String: ColI = "I"
Dim ColJ As String: ColJ = "J"
Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ColI).Value)
Dim address2 As String: address2 = Trim(Me.Cells(rowNum, ColJ).Value)
If address1 = "" Then
If address2 <> "" Then
Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid"
Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Else
Dim empNo As String: empNo = Trim(Me.Cells(rowNum, 3).Value)
If Not o1Cache.Exists(empNo) Then
Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid"
Me.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim innerDict As Object: Set innerDict = o1Cache(empNo)
If Not innerDict.Exists(address1) Then
Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid"
Me.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim addr2Dict As Object: Set addr2Dict = innerDict(address1)
If Not addr2Dict.Exists(address2) Then
Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid"
Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
' K column
If Trim(Me.Cells(rowNum, "K").Value) <> "" Then
Me.Cells(rowNum, errorCol).Value = "K" & " column can not be input"
Me.Range("K" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' validate CodeSelect
' M column [todoke Cde]
Dim ColG As String: ColG = "G"
Dim todoke As String: todoke = Trim(Me.Cells(rowNum, ColG).Value)
If todoke <> "" Then
Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
Dim todokeCde As String: todokeCde = GetCode(todoke)
If Not z4Cache.Exists(todokeCde) Then
Me.Cells(rowNum, errorCol).Value = ColG & " column is invalid"
Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
Me.Cells(rowNum, errorCol).ClearContents
End Sub