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

20260515指摘対応8

Browse Source
This commit is contained in:
guanxiangwei
2026-05-21 16:02:08 +09:00
parent bee1cd9810
commit 0a633d711c
6 changed files with 315 additions and 252 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
src/sh/tuk/sheet/M1.cls
View File

@@ -59,11 +59,13 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
' Check column required
Dim colLetter As Variant
For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L")
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum)
errorCell.Value = GetErrorMsg("E002", colLetter & rowNum)
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -73,7 +75,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
For Each colLetter In Array("H", "I", "J", "N")
Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value)
If val <> "" And Not IsNumeric(val) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", colLetter & rowNum)
errorCell.Value = GetErrorMsg("E011", colLetter & rowNum)
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -85,7 +87,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Set foundCell = ws.Range("C7:C" & lastDataRow).Find(What:=cValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not foundCell Is Nothing Then
If foundCell.Row <> rowNum Then
ws.Cells(rowNum, errorCol).Value = "C column value is duplicated"
errorCell.Value = "C column value is duplicated"
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -98,14 +100,14 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
If Not z1Cache.Exists(dValue) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "D" & rowNum)
errorCell.Value = GetErrorMsg("E004", "D" & rowNum)
ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
Else
Dim valueArray As Variant
valueArray = z1Cache(dValue)
If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then
ws.Cells(rowNum, errorCol).Value = "Invalid reference data for D column."
errorCell.Value = "Invalid reference data for D column."
Exit Sub
End If
@@ -113,7 +115,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
expectedEValue = Trim(CStr(valueArray(0)))
If eValue <> expectedEValue Then
ws.Cells(rowNum, errorCol).Value = "E column does not match reference data."
errorCell.Value = "E column does not match reference data."
ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -123,13 +125,15 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
If Not tokubetuList.Exists(lValue) Then
ws.Cells(rowNum, errorCol).Value = "L column does not exist."
errorCell.Value = "L column does not exist."
ws.Range("L" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' Validation passed - clear error
ws.Cells(rowNum, errorCol).ClearContents
If Not StartsWith(errorCell.Value, "W") Then
errorCell.ClearContents
End If
Exit Sub
ErrHandler:
@@ -150,8 +154,10 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A
Dim valsD As Variant: valsD = z1Cache(dVal)
ws.Cells(r, 5).Value = valsD(0) ' Column E
End If
Call BuildTokubetuDropdown(ws, "L", r)
Call BuildRenrakuDropdown(ws, "K", r)
Next r
Application.EnableEvents = True
Exit Sub