m2 update
This commit is contained in:
20
src/data/区間詳細.csv
Normal file
20
src/data/区間詳細.csv
Normal file
@@ -0,0 +1,20 @@
|
||||
利用区間コード,券種,コード,名称,1箇月運賃/販売額,定期額/券1(額)/利用額,定期支給期間/券1(枚)/特別料金,特別料金/券2(額),券2(枚),端数(額),特別料金
|
||||
00001,1,003,6箇月定期,7920,47520,6,,,,
|
||||
00001,2,001,テスト,15000,0,0,0,0,0,
|
||||
00001,3,001,プリペイドカード,20000,20000,,,,,
|
||||
00002,1,003,6箇月定期,1451.833,8711,6,,,,
|
||||
00002,2,001,テスト,15000,0,0,0,0,0,
|
||||
00002,3,002,0002テスト,45000,60000,,,,,
|
||||
00003,2,002,テスト2,500,500,10,500,10,0,
|
||||
00004,3,003,0004テスト,5000,5000,,,,,
|
||||
00005,1,003,6箇月定期,4753.333,28520,6,,,,
|
||||
00006,1,001,1箇月定期,7920,7920,1,,,,
|
||||
00006,1,003,6箇月定期,7920,47520,6,,,,
|
||||
00021,1,001,1箇月定期,6260,6260,1,,,,
|
||||
00038,1,001,1箇月定期,6260,6260,1,,,,
|
||||
00056,1,003,6箇月定期,10030,10030,1,,,,
|
||||
00067,1,003,6箇月定期,4486.666,26920,6,,,,
|
||||
00068,1,003,6箇月定期,52800,316800,6,,,,
|
||||
00069,1,006,6箇月,7181.666,43090,6,,,,
|
||||
00070,1,003,6箇月定期,6426.666,38560,6,,,,
|
||||
00071,1,003,6箇月定期,6879,6879,1,,,,
|
||||
|
@@ -2,6 +2,25 @@
|
||||
' Common Functions
|
||||
' ============================================================
|
||||
|
||||
' Get CSV header from specified row and columns
|
||||
Function GetCSVHeader(ByVal ws As Worksheet, ByVal colLetters As Variant, ByVal headerRow As Long) As Variant
|
||||
Dim colCount As Long: colCount = UBound(colLetters) - LBound(colLetters) + 1
|
||||
Dim headerArr() As String
|
||||
ReDim headerArr(1 To 1, 1 To colCount)
|
||||
|
||||
Dim i As Long
|
||||
Dim cellValue As String
|
||||
For i = 0 To colCount - 1
|
||||
cellValue = Trim(ws.Cells(headerRow, Columns(colLetters(i)).Column).Value)
|
||||
cellValue = Replace(cellValue, vbLf, "")
|
||||
cellValue = Replace(cellValue, vbCr, "")
|
||||
cellValue = Replace(cellValue, vbCrLf, "")
|
||||
headerArr(1, i + 1) = cellValue
|
||||
Next i
|
||||
|
||||
GetCSVHeader = headerArr
|
||||
End Function
|
||||
|
||||
Function CleanCSVField(ByVal inputStr As String) As String
|
||||
Dim s As String
|
||||
s = Trim(inputStr)
|
||||
@@ -145,7 +164,9 @@ Function ClearDataRows(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endC
|
||||
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws, startCol, endCol, startRow)
|
||||
|
||||
If lastDataRow >= startRow Then
|
||||
ws.Range(ws.Cells(startRow, startCol), ws.Cells(lastDataRow, endCol)).ClearContents
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(startRow, startCol), ws.Cells(lastDataRow, endCol))
|
||||
clearRange.ClearContents
|
||||
clearRange.Interior.Color = vbWhite
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
@@ -49,7 +49,7 @@ Function ReadCSVAs2DArrayStrict( _
|
||||
.Close
|
||||
End With
|
||||
|
||||
' === stardand ===
|
||||
' === standardize ===
|
||||
textContent = Replace(textContent, vbCrLf, vbLf)
|
||||
textContent = Replace(textContent, vbCr, vbLf)
|
||||
|
||||
@@ -135,6 +135,10 @@ Private Function ParseCSVLines(ByVal csvText As String) As Collection
|
||||
currentField = currentField & c
|
||||
i = i + 1
|
||||
Else
|
||||
' Clean field before adding
|
||||
currentField = Trim(currentField)
|
||||
currentField = Replace(currentField, vbCr, "")
|
||||
currentField = Replace(currentField, vbLf, "")
|
||||
currentRow.Add currentField
|
||||
currentField = ""
|
||||
i = i + 1
|
||||
@@ -167,6 +171,10 @@ Private Function ParseCSVLines(ByVal csvText As String) As Collection
|
||||
|
||||
' Handle last row without trailing newline
|
||||
If currentField <> "" Or currentRow.Count > 0 Then
|
||||
' Clean field before adding
|
||||
currentField = Trim(currentField)
|
||||
currentField = Replace(currentField, vbCr, "")
|
||||
currentField = Replace(currentField, vbLf, "")
|
||||
currentRow.Add currentField
|
||||
Dim lastArr() As String
|
||||
If currentRow.Count > 0 Then
|
||||
|
||||
@@ -1,13 +1,16 @@
|
||||
' ====== (222) =======
|
||||
|
||||
' ====== Constants ======
|
||||
Const START_COL As Long = 3 ' C column
|
||||
Const END_COL As Long = 14 ' N column
|
||||
Const ERROR_COL As Long = 15 ' O column
|
||||
Const START_COL As Long = 3 ' C column
|
||||
Const END_COL As Long = 14 ' N column
|
||||
Const ERROR_COL As Long = 15 ' O column
|
||||
Const M1_HEADER_ROW As Long = 5
|
||||
|
||||
Private z1Cache As Object ' Z1 cache
|
||||
Private enumCache As Object ' Z1 cache
|
||||
|
||||
Function HEADERS() As Variant
|
||||
HEADERS = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
|
||||
End Function
|
||||
|
||||
' ====== Function ======
|
||||
Public Sub RefreshZ1Cache()
|
||||
On Error GoTo RefreshError
|
||||
@@ -67,23 +70,6 @@ Private Sub CreateEnumDropdown(ByVal rowNum As Long)
|
||||
|
||||
End Sub
|
||||
|
||||
' Get CSV header from row 5 (columns C to N)
|
||||
Function GetM1CSVHeader(ByVal ws As Worksheet) As Variant
|
||||
Dim headerArr(1 To 1, 1 To 12) As String
|
||||
Dim i As Long
|
||||
Dim cellValue As String
|
||||
|
||||
For i = 1 To 12
|
||||
cellValue = Trim(ws.Cells(5, i + 2).Value) ' i+2: 1→3(C), 12→14(N)
|
||||
' Remove line breaks
|
||||
cellValue = Replace(cellValue, vbLf, "")
|
||||
cellValue = Replace(cellValue, vbCr, "")
|
||||
cellValue = Replace(cellValue, vbCrLf, "")
|
||||
headerArr(1, i) = cellValue
|
||||
Next i
|
||||
|
||||
GetM1CSVHeader = headerArr
|
||||
End Function
|
||||
|
||||
Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
' === Column C changes: Create L column dropdown ===
|
||||
@@ -121,11 +107,8 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
End Sub
|
||||
|
||||
Sub M1_Import()
|
||||
Dim wsTarget As Worksheet: Set wsTarget = Me
|
||||
|
||||
' === Step 1: Select CSV file ===
|
||||
Dim filePath As String
|
||||
filePath = SelectCSVFile()
|
||||
Dim filePath As String: filePath = SelectCSVFile()
|
||||
If filePath = "" Then Exit Sub
|
||||
|
||||
' === Step 2: Read CSV with Shift-JIS (using common function) ===
|
||||
@@ -137,19 +120,22 @@ Sub M1_Import()
|
||||
MsgBox "No data in CSV.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' === Step 3:Clear all data rows before import ===
|
||||
Application.EnableEvents = False
|
||||
Dim wsTarget As Worksheet: Set wsTarget = Me
|
||||
Call ClearDataRows(wsTarget, START_COL, END_COL, 7)
|
||||
Application.EnableEvents = True
|
||||
|
||||
' === Step 3: Write CSV data to worksheet (forward order) ===
|
||||
Dim i As Long
|
||||
' === Step 4: Write CSV data to worksheet ===
|
||||
Dim colLetters As Variant: colLetters = HEADERS()
|
||||
Dim writeRow As Long: writeRow = 7
|
||||
Dim i As Long
|
||||
For i = LBound(csvData, 1) To UBound(csvData, 1)
|
||||
' CSV col 1-12 -> C-N column
|
||||
Dim j As Long
|
||||
For j = 1 To 12
|
||||
wsTarget.Cells(writeRow, j + 2).Value = CleanCSVField(CStr(csvData(i, j)))
|
||||
For j = 0 To 11
|
||||
wsTarget.Cells(writeRow, Columns(colLetters(j)).Column).Value = CleanCSVField(CStr(csvData(i, j + 1)))
|
||||
Next j
|
||||
writeRow = writeRow + 1
|
||||
Next i
|
||||
@@ -268,10 +254,8 @@ Sub M1_Export()
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim ws As Worksheet
|
||||
Set ws = Me
|
||||
|
||||
' === Step 1: Validate all rows before export ===
|
||||
Dim ws As Worksheet: Set ws = Me
|
||||
Dim r As Long, errorCount As Long
|
||||
For r = 7 To lastDataRow
|
||||
Call validate(r, lastDataRow)
|
||||
@@ -286,8 +270,7 @@ Sub M1_Export()
|
||||
End If
|
||||
|
||||
' === Step 2: Select save path ===
|
||||
Dim savePath As String
|
||||
savePath = GetSaveCSVPath()
|
||||
Dim savePath As String: savePath = GetSaveCSVPath()
|
||||
If savePath = "" Then Exit Sub
|
||||
|
||||
' === Step 3: Count data rows ===
|
||||
@@ -295,22 +278,23 @@ Sub M1_Export()
|
||||
|
||||
' === Step 4: Build array with header and data ===
|
||||
Dim headerArr As Variant
|
||||
headerArr = GetM1CSVHeader(ws)
|
||||
Dim colLetters As Variant: colLetters = HEADERS()
|
||||
headerArr = GetCSVHeader(ws, colLetters, M1_HEADER_ROW)
|
||||
|
||||
Dim outputArr As Variant
|
||||
ReDim outputArr(1 To rowCount + 1, 1 To 12)
|
||||
|
||||
' Row 1: header
|
||||
Dim colIdx As Long
|
||||
For colIdx = 1 To 12
|
||||
outputArr(1, colIdx) = headerArr(1, colIdx)
|
||||
For colIdx = 0 To 11
|
||||
outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1)
|
||||
Next colIdx
|
||||
|
||||
' Rows 2+: data (C-N columns)
|
||||
Dim dataRow As Long: dataRow = 2
|
||||
For r = 7 To lastDataRow
|
||||
For colIdx = 1 To 12
|
||||
outputArr(dataRow, colIdx) = CleanCSVField(ws.Cells(r, colIdx + 2).Value)
|
||||
For colIdx = 0 To 11
|
||||
outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx)).Column).Value)
|
||||
Next colIdx
|
||||
dataRow = dataRow + 1
|
||||
Next r
|
||||
|
||||
@@ -1,5 +1,30 @@
|
||||
' CSV Header Constants
|
||||
Const CSV_HEADER As String = "利用区間コード,券種,コード,名称,1箇月運賃/販売額,定期額/券1(額)/利用額,定期支給期間/券1(枚)/特別料金,特別料金/券2(額),券2(枚),端数(額),特別料金"
|
||||
' ====== Constants ======
|
||||
Const START_COL As Long = 3 ' C column
|
||||
Const END_COL As Long = 18 ' R column
|
||||
Const ERROR_COL As Long = 19 ' S column
|
||||
Const M2_HEADER_ROW As Long = 6
|
||||
|
||||
Private m1Cache As Object ' M1 cache
|
||||
|
||||
Function HEADERS() As Variant
|
||||
HEADERS = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R")
|
||||
End Function
|
||||
|
||||
' ====== Function ======
|
||||
Public Sub RefreshM1Cache()
|
||||
On Error GoTo RefreshError
|
||||
Set m1Cache = LoadLookup("M1", keyCol:=3, valueCols:=Array(4), startRow:=7)
|
||||
On Error GoTo 0
|
||||
|
||||
If m1Cache Is Nothing Or m1Cache.Count = 0 Then
|
||||
Err.Raise 1001, "RefreshM1Cache", "M1 reference data is empty"
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
RefreshError:
|
||||
Err.Raise 1002, "RefreshM1Cache", "Failed to load M1 lookup cache: " & Err.Description
|
||||
End Sub
|
||||
|
||||
Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
' === Fill D, E when C column changes ===
|
||||
@@ -9,13 +34,13 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
If Trim(cell.Value) = "" Then
|
||||
Call ClearRowData(Me, cell.Row)
|
||||
Else
|
||||
Call FillFromKukanMaster(Me, cell.Row)
|
||||
Call FillFromM1(Me, cell.Row)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Sub FillFromKukanMaster(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
|
||||
Sub FillFromM1(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
|
||||
Dim wsKukan As Worksheet
|
||||
Dim lastRow As Long
|
||||
Dim i As Long
|
||||
@@ -54,310 +79,190 @@ Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||
ws.Cells(rowNum, 19).ClearContents ' Q column error info
|
||||
End Sub
|
||||
|
||||
Sub ImportMasterDetailData()
|
||||
Dim filePath As String
|
||||
Dim fileDialog As FileDialog
|
||||
Dim wsTarget As Worksheet
|
||||
Dim stream As Object
|
||||
Dim textContent As String
|
||||
Dim lines As Variant
|
||||
Dim i As Long
|
||||
Dim dataArray As Variant
|
||||
Dim code As String
|
||||
Dim lastRow As Long
|
||||
Dim r As Long
|
||||
' Target this worksheet
|
||||
Set wsTarget = Me
|
||||
|
||||
Sub M2_Import()
|
||||
' === Step 1: Select CSV file ===
|
||||
Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
|
||||
With fileDialog
|
||||
.Filters.Clear
|
||||
.Filters.Add "CSV Files", "*.csv"
|
||||
.AllowMultiSelect = False
|
||||
If .Show <> -1 Then Exit Sub
|
||||
filePath = .SelectedItems(1)
|
||||
End With
|
||||
|
||||
' === Step 2: Read CSV with Shift-JIS ===
|
||||
Set stream = CreateObject("ADODB.Stream")
|
||||
With stream
|
||||
.Type = 2
|
||||
.Charset = "shift_jis"
|
||||
.Open
|
||||
.LoadFromFile filePath
|
||||
textContent = .ReadText
|
||||
.Close
|
||||
End With
|
||||
|
||||
lines = Split(textContent, vbLf)
|
||||
|
||||
' === Validate CSV header ===
|
||||
If UBound(lines) >= 0 And Trim(lines(0)) <> "" Then
|
||||
Dim csvHeader As String
|
||||
csvHeader = Trim(lines(0))
|
||||
' Validate column count
|
||||
Dim expectedCount As Long
|
||||
expectedCount = UBound(Split(CSV_HEADER, ",")) + 1
|
||||
Dim headerFields As Variant
|
||||
headerFields = Split(csvHeader, ",")
|
||||
If UBound(headerFields) + 1 <> expectedCount Then
|
||||
MsgBox "CSV column count mismatch. Expected: " & expectedCount & ", Got: " & UBound(headerFields) + 1, vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
' === Clear all data rows before import ===
|
||||
lastRow = wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Row
|
||||
If lastRow >= 7 Then
|
||||
wsTarget.Range("A7:P" & lastRow).ClearContents
|
||||
End If
|
||||
|
||||
If UBound(lines) < 1 Then
|
||||
Dim filePath As String: filePath = SelectCSVFile()
|
||||
If filePath = "" Then Exit Sub
|
||||
|
||||
' === Step 2: Read CSV with Shift-JIS (using common function) ===
|
||||
On Error GoTo ImportError
|
||||
Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, 11, "shift_jis", True)
|
||||
On Error GoTo 0
|
||||
|
||||
If UBound(csvData, 1) < 1 Then
|
||||
MsgBox "No data in CSV.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' === Step 3: Collect CSV codes and data ===
|
||||
Dim csvData As Object
|
||||
Set csvData = CreateObject("Scripting.Dictionary")
|
||||
|
||||
For i = 1 To UBound(lines)
|
||||
If Trim(lines(i)) = "" Then GoTo NextCsvLine
|
||||
dataArray = Split(lines(i), ",")
|
||||
If UBound(dataArray) >= 0 Then
|
||||
code = CleanCSVField(CStr(dataArray(0)))
|
||||
If code <> "" Then
|
||||
' Use unique key: code + "_" + row index to avoid duplicate key error
|
||||
csvData.Add code & "_" & i, dataArray
|
||||
End If
|
||||
End If
|
||||
NextCsvLine:
|
||||
Next i
|
||||
|
||||
If csvData.Count = 0 Then
|
||||
MsgBox "No valid code found.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' === Step 6: Write CSV data to next available row ===
|
||||
writeRow = 7
|
||||
|
||||
For i = 1 To UBound(lines)
|
||||
If Trim(lines(i)) = "" Then GoTo NextLine
|
||||
|
||||
dataArray = Split(lines(i), ",")
|
||||
|
||||
' CSV col 1 -> C column
|
||||
code = CleanCSVField(CStr(dataArray(0)))
|
||||
wsTarget.Cells(writeRow, 3).Value = code
|
||||
|
||||
' CSV col 2-11 -> G-P column
|
||||
If UBound(dataArray) >= 1 Then wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(dataArray(1)))
|
||||
If UBound(dataArray) >= 2 Then wsTarget.Cells(writeRow, 10).Value = CleanCSVField(CStr(dataArray(2)))
|
||||
If UBound(dataArray) >= 3 Then wsTarget.Cells(writeRow, 11).Value = CleanCSVField(CStr(dataArray(3)))
|
||||
If UBound(dataArray) >= 4 Then wsTarget.Cells(writeRow, 12).Value = CleanCSVField(CStr(dataArray(4)))
|
||||
If UBound(dataArray) >= 5 Then wsTarget.Cells(writeRow, 13).Value = CleanCSVField(CStr(dataArray(5)))
|
||||
If UBound(dataArray) >= 6 Then wsTarget.Cells(writeRow, 14).Value = CleanCSVField(CStr(dataArray(6)))
|
||||
If UBound(dataArray) >= 7 Then wsTarget.Cells(writeRow, 15).Value = CleanCSVField(CStr(dataArray(7)))
|
||||
If UBound(dataArray) >= 8 Then wsTarget.Cells(writeRow, 16).Value = CleanCSVField(CStr(dataArray(8)))
|
||||
If UBound(dataArray) >= 9 Then wsTarget.Cells(writeRow, 17).Value = CleanCSVField(CStr(dataArray(9)))
|
||||
If UBound(dataArray) >= 10 Then wsTarget.Cells(writeRow, 18).Value = CleanCSVField(CStr(dataArray(10)))
|
||||
|
||||
' Auto-fill D, E columns
|
||||
Call FillFromKukanMaster(wsTarget, writeRow, False)
|
||||
|
||||
' G column has value → trigger F dropdown
|
||||
' === Step 3:Clear all data rows before import ===
|
||||
Application.EnableEvents = False
|
||||
Dim wsTarget As Worksheet: Set wsTarget = Me
|
||||
Call ClearDataRows(wsTarget, START_COL, ERROR_COL, 7)
|
||||
Application.EnableEvents = True
|
||||
|
||||
|
||||
' === Step 4: Write CSV data to worksheet ===
|
||||
Dim colLetters As Variant: colLetters = HEADERS()
|
||||
Dim writeRow As Long: writeRow = 7
|
||||
Dim i As Long
|
||||
For i = LBound(csvData, 1) To UBound(csvData, 1)
|
||||
' CSV col 1-11 -> C, I-R column
|
||||
Dim j As Long
|
||||
For j = 0 To 10
|
||||
wsTarget.Cells(writeRow, Columns(colLetters(j)).Column).Value = CleanCSVField(CStr(csvData(i, j + 1)))
|
||||
Next j
|
||||
writeRow = writeRow + 1
|
||||
NextLine:
|
||||
Next i
|
||||
|
||||
|
||||
MsgBox writeRow - 7 & " rows imported.", vbInformation
|
||||
Exit Sub
|
||||
|
||||
ImportError:
|
||||
MsgBox "CSV import failed: " & Err.Description, vbExclamation
|
||||
End Sub
|
||||
|
||||
Function CleanCSVField(ByVal field As Variant) As String
|
||||
If IsEmpty(field) Or IsNull(field) Then
|
||||
CleanCSVField = ""
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim result As String
|
||||
result = Trim(CStr(field))
|
||||
|
||||
If Len(result) >= 2 Then
|
||||
If Left(result, 1) = """" And Right(result, 1) = """" Then
|
||||
result = Mid(result, 2, Len(result) - 2)
|
||||
result = Replace(result, """""", """")
|
||||
End If
|
||||
End If
|
||||
CleanCSVField = result
|
||||
End Function
|
||||
Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
Set ws = Me
|
||||
|
||||
Sub validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||
' Check C column not empty
|
||||
If Trim(ws.Cells(rowNum, 3).Value) = "" Then
|
||||
ws.Cells(rowNum, 19).ClearContents
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Check G, H required and numeric (for composite key)
|
||||
If Trim(ws.Cells(rowNum, 9).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 9).Value) Then
|
||||
ws.Cells(rowNum, 19).Value = "G column (I) is required and must be numeric"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Trim(ws.Cells(rowNum, 10).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 10).Value) Then
|
||||
ws.Cells(rowNum, 19).Value = "H column (J) is required and must be numeric"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Check I (K column) required
|
||||
If Trim(ws.Cells(rowNum, 11).Value) = "" Then
|
||||
ws.Cells(rowNum, 19).Value = "I column (K) is required"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Check J, K required and numeric
|
||||
If Trim(ws.Cells(rowNum, 12).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 12).Value) Then
|
||||
ws.Cells(rowNum, 19).Value = "J column (L) is required and must be numeric"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Trim(ws.Cells(rowNum, 13).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 13).Value) Then
|
||||
ws.Cells(rowNum, 19).Value = "K column (M) is required and must be numeric"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Check L-P optional but must be numeric if entered
|
||||
Dim col As Long
|
||||
Dim colName As String
|
||||
Dim colLetter As String
|
||||
colLetter = "NOPQR"
|
||||
|
||||
For col = 14 To 18
|
||||
If Trim(ws.Cells(rowNum, col).Value) <> "" And Not IsNumeric(ws.Cells(rowNum, col).Value) Then
|
||||
colName = Mid(colLetter, col - 13, 1)
|
||||
ws.Cells(rowNum, 19).Value = colName & " column must be numeric"
|
||||
Dim clearRange As Range
|
||||
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
|
||||
' Check column required
|
||||
Dim colLetter As Variant
|
||||
For Each colLetter In Array("C", "I", "J", "K")
|
||||
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
|
||||
ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column is required"
|
||||
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next colLetter
|
||||
|
||||
' Check column numeric (only if has value)
|
||||
Dim numericCols As Variant: numericCols = Array("L", "M", "N", "O", "P", "Q", "R")
|
||||
Dim col As Variant
|
||||
For Each col In numericCols
|
||||
Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "")
|
||||
If val <> "" And Not IsNumeric(val) Then
|
||||
ws.Cells(rowNum, ERROR_COL).Value = col & " column must be numeric"
|
||||
ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next col
|
||||
|
||||
' Check GH composite key duplicate
|
||||
Dim g As String, h As String
|
||||
Dim r As Long
|
||||
Dim lastRow As Long
|
||||
|
||||
g = Trim(ws.Cells(rowNum, 9).Value)
|
||||
h = Trim(ws.Cells(rowNum, 10).Value)
|
||||
|
||||
lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
|
||||
|
||||
For r = 7 To lastRow
|
||||
If r <> rowNum And Trim(ws.Cells(r, 3).Value) = Trim(ws.Cells(rowNum, 3).Value) Then
|
||||
If Trim(ws.Cells(r, 9).Value) = g And Trim(ws.Cells(r, 10).Value) = h Then
|
||||
ws.Cells(rowNum, 19).Value = "GH (I,J) combination already exists"
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next r
|
||||
|
||||
' Validation passed
|
||||
ws.Cells(rowNum, 19).ClearContents
|
||||
|
||||
' Check C column in the cache
|
||||
If m1Cache Is Nothing Then Call RefreshM1Cache
|
||||
Dim dValue As String: dValue = Trim(ws.Range("C" & rowNum).Value)
|
||||
|
||||
If Not m1Cache.Exists(dValue) Then
|
||||
ws.Cells(rowNum, ERROR_COL).Value = "C column does not exist in M1."
|
||||
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Check I column in the kenshuKbn
|
||||
Dim kenshuKbn As Variant: kenshuKbn = Array("1", "2", "3")
|
||||
Dim iValue As String: iValue = Trim(ws.Range("I" & rowNum).Value)
|
||||
If UBound(Filter(kenshuKbn, iValue)) = -1 Then
|
||||
ws.Cells(rowNum, ERROR_COL).Value = "I column (kenshuKbn) must be 1, 2, or 3"
|
||||
ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
' Button macro (Validate selected row)
|
||||
Sub validateDetailDataButton()
|
||||
Dim ws As Worksheet
|
||||
Dim lastRow As Long
|
||||
Dim r As Long
|
||||
Dim errorCount As Long
|
||||
|
||||
Set ws = ActiveSheet
|
||||
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
|
||||
|
||||
If lastRow < 7 Then
|
||||
Sub M2_validateButton()
|
||||
Dim lastDataRow As Long, r As Long, errorCount As Long
|
||||
lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
|
||||
|
||||
If lastDataRow < 7 Then
|
||||
MsgBox "No data found.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
errorCount = 0
|
||||
For r = 7 To lastRow
|
||||
Call validateDetailData(ws, r)
|
||||
If Trim(ws.Cells(r, 17).Value) <> "" Then
|
||||
|
||||
For r = 7 To lastDataRow
|
||||
Validate r, lastDataRow
|
||||
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
|
||||
errorCount = errorCount + 1
|
||||
End If
|
||||
Next r
|
||||
|
||||
MsgBox "Validation complete. Errors: " & errorCount & ", ", vbInformation
|
||||
|
||||
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
|
||||
End Sub
|
||||
|
||||
Sub ExportMasterDetailData()
|
||||
Dim ws As Worksheet
|
||||
Set ws = ActiveSheet
|
||||
|
||||
Dim lastDataRow As Long
|
||||
lastDataRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
|
||||
|
||||
Sub M2_Export()
|
||||
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
|
||||
If lastDataRow < 7 Then
|
||||
MsgBox "No data rows to output.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim savePath As String
|
||||
savePath = Application.GetSaveAsFilename( _
|
||||
FileFilter:="CSV Files (*.csv), *.csv", _
|
||||
Title:="Save CSV")
|
||||
|
||||
If savePath = "False" Then Exit Sub
|
||||
If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then
|
||||
savePath = savePath & ".csv"
|
||||
End If
|
||||
|
||||
' Build header from row 5 (columns C, G-P)
|
||||
Dim csvContent As String
|
||||
csvContent = Trim(ws.Cells(5, 3).Value)
|
||||
Dim j As Long
|
||||
For j = 7 To 16
|
||||
csvContent = csvContent & "," & Trim(ws.Cells(5, j).Value)
|
||||
Next j
|
||||
csvContent = csvContent & vbLf
|
||||
|
||||
' Row counter
|
||||
Dim rowCount As Long
|
||||
rowCount = 0
|
||||
|
||||
' Data: C,G,H,I,J,K,L,M,N,O,P (skip D,E,F)
|
||||
Dim r As Long
|
||||
|
||||
' === Step 1: Validate all rows before export ===
|
||||
Dim ws As Worksheet: Set ws = Me
|
||||
Dim r As Long, errorCount As Long
|
||||
For r = 7 To lastDataRow
|
||||
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
||||
rowCount = rowCount + 1
|
||||
' CSV col1 -> C column
|
||||
csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value)
|
||||
' CSV col2-11 -> I-R column
|
||||
For j = 9 To 18
|
||||
csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
|
||||
Next j
|
||||
csvContent = csvContent & vbLf
|
||||
Call validate(r, lastDataRow)
|
||||
If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then
|
||||
errorCount = errorCount + 1
|
||||
End If
|
||||
Next r
|
||||
|
||||
' Trim trailing empty lines
|
||||
Do While Right(csvContent, 1) = vbLf
|
||||
csvContent = Left(csvContent, Len(csvContent) - 1)
|
||||
Loop
|
||||
|
||||
' Write file
|
||||
Dim stream As Object
|
||||
Set stream = CreateObject("ADODB.Stream")
|
||||
stream.Type = 2
|
||||
stream.Charset = "shift_jis"
|
||||
stream.Open
|
||||
stream.WriteText csvContent, 1
|
||||
stream.SaveToFile savePath, 2
|
||||
stream.Close
|
||||
|
||||
|
||||
If errorCount > 0 Then
|
||||
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' === Step 2: Select save path ===
|
||||
Dim savePath As String: savePath = GetSaveCSVPath()
|
||||
If savePath = "" Then Exit Sub
|
||||
|
||||
' === Step 3: Count data rows ===
|
||||
Dim rowCount As Long: rowCount = lastDataRow - 6
|
||||
|
||||
' === Step 4: Build array with header and data ===
|
||||
Dim headerArr As Variant
|
||||
Dim colLetters As Variant: colLetters = HEADERS()
|
||||
headerArr = GetCSVHeader(ws, colLetters, M2_HEADER_ROW)
|
||||
|
||||
Dim outputArr As Variant
|
||||
ReDim outputArr(1 To rowCount + 1, 1 To 11)
|
||||
|
||||
' Row 1: header
|
||||
Dim colIdx As Long
|
||||
For colIdx = 0 To 10
|
||||
outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1)
|
||||
Next colIdx
|
||||
|
||||
' Rows 2+: data (C, I-R columns)
|
||||
Dim dataRow As Long: dataRow = 2
|
||||
For r = 7 To lastDataRow
|
||||
For colIdx = 0 To 10
|
||||
outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx)).Column).Value)
|
||||
Next colIdx
|
||||
dataRow = dataRow + 1
|
||||
Next r
|
||||
|
||||
On Error GoTo ExportError
|
||||
Call WriteCSVFromArray(savePath, outputArr, "shift_jis", False)
|
||||
On Error GoTo 0
|
||||
|
||||
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
|
||||
Exit Sub
|
||||
|
||||
ExportError:
|
||||
MsgBox "CSV export failed: " & Err.Description, vbExclamation
|
||||
|
||||
End Sub
|
||||
|
||||
Sub M2_SortDataRowsByC()
|
||||
Call SortDataRows(3)
|
||||
End Sub
|
||||
|
||||
Sub M2_ToggleAutoFilter()
|
||||
Call ToggleAutoFilter(START_COL, END_COL)
|
||||
End Sub
|
||||
|
||||
Sub M2_AutoFitColumnWidth()
|
||||
Call AutoFitColumnWidth(START_COL, END_COL)
|
||||
End Sub
|
||||
Binary file not shown.
Reference in New Issue
Block a user