diff --git a/src/thisWorkbook/Kotsu_master.bas b/src/thisWorkbook/Master_222.bas similarity index 82% rename from src/thisWorkbook/Kotsu_master.bas rename to src/thisWorkbook/Master_222.bas index fd1fa5c..68540c9 100644 --- a/src/thisWorkbook/Kotsu_master.bas +++ b/src/thisWorkbook/Master_222.bas @@ -1,226 +1,258 @@ -Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) - ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents - ws.Cells(rowNum, 2).ClearContents -End Sub - -Sub Z1_Import() - Dim filePath As String - Dim wsTarget As Worksheet - Dim lines As Variant - Dim i As Long - Dim dataArray As Variant - Dim code As String - Dim writeRow As Long - - Set wsTarget = Me - On Error GoTo ErrorHandler - - ' Step 1: Select CSV file - filePath = SelectCSVFile() - If filePath = "" Then Exit Sub - - ' Step 2: Read CSV and return 2D array - lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8") - - ' Step 3: Clear data rows - Call ClearDataRows(wsTarget, 7, 3) - - ' Step 4: Import data - writeRow = 7 - For i = LBound(lines, 1) To UBound(lines, 1) - If Not isRowEmpty Then - wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1))) - wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2))) - wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3))) - wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4))) - wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5))) - wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6))) - wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7))) - - writeRow = writeRow + 1 - End If - Next i - - MsgBox writeRow - 7 & " rows imported.", vbInformation - - Exit Sub - -ErrorHandler: - MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical -End Sub - -Sub Z1_Export() - Dim ws As Worksheet - Dim lastDataRow As Long - Dim savePath As String - Dim r As Long - Dim rowCount As Long - Dim dataArray() As Variant - Dim dataIdx As Long - Dim j As Long - - Set ws = ActiveSheet - - lastDataRow = GetLastDataRow(ws, 3) - - If lastDataRow < 7 Then - MsgBox "No data rows to output.", vbExclamation - Exit Sub - End If - - savePath = GetSaveCSVPath() - If savePath = "" Then Exit Sub - - ' Count valid rows first (C column non-empty from row 7 onward) - rowCount = 0 - For r = 7 To lastDataRow - If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then - rowCount = rowCount + 1 - End If - Next r - - ' If no data, exit - If rowCount = 0 Then - MsgBox "No data rows to output.", vbExclamation - Exit Sub - End If - - ' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9) - ReDim dataArray(1 To rowCount, 1 To 7) - - ' Fill the array - dataIdx = 0 - For r = 7 To lastDataRow - If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then - dataIdx = dataIdx + 1 - For j = 3 To 9 - dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7 - Next j - End If - Next r - - ' Write using the new array-based CSV writer - Call WriteCSVFromArray(savePath, dataArray, "utf-8", True) - - MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation -End Sub - -Sub Z1_validate(ByVal ws As Worksheet, ByVal rowNum As Long) - Dim cValue As String - cValue = Trim(ws.Cells(rowNum, 3).Value) - - If cValue = "" Then - ws.Cells(rowNum, 2).Value = "C column is required" - Exit Sub - End If - - If Len(cValue) <> 3 Then - ws.Cells(rowNum, 2).Value = "C column must be 3 characters" - Exit Sub - End If - - Dim i As Long - Dim ch As String - For i = 1 To 3 - ch = Mid(cValue, i, 1) - If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then - ws.Cells(rowNum, 2).Value = "C column must be alphanumeric" - Exit Sub - End If - Next i - - Dim dValue As String - dValue = Trim(ws.Cells(rowNum, 4).Value) - If dValue = "" Then - ws.Cells(rowNum, 2).Value = "D column is required" - Exit Sub - End If - If Len(dValue) > 80 Then - ws.Cells(rowNum, 2).Value = "D column must be within 80 characters" - Exit Sub - End If - - Dim eValue As String - eValue = Trim(ws.Cells(rowNum, 5).Value) - If eValue = "" Then - ws.Cells(rowNum, 2).Value = "E column is required" - Exit Sub - End If - If Len(eValue) > 80 Then - ws.Cells(rowNum, 2).Value = "E column must be within 80 characters" - Exit Sub - End If - - Dim fValue As String - fValue = Trim(ws.Cells(rowNum, 6).Value) - If fValue <> "" And Len(fValue) > 80 Then - ws.Cells(rowNum, 2).Value = "F column must be within 80 characters" - Exit Sub - End If - - Dim gValue As String - gValue = Trim(ws.Cells(rowNum, 7).Value) - If gValue <> "" And Len(gValue) > 80 Then - ws.Cells(rowNum, 2).Value = "G column must be within 80 characters" - Exit Sub - End If - - Dim iValue As String - iValue = Trim(ws.Cells(rowNum, 9).Value) - If iValue <> "" And Len(iValue) > 80 Then - ws.Cells(rowNum, 2).Value = "I column must be within 80 characters" - Exit Sub - End If - - Dim hValue As String - hValue = Trim(ws.Cells(rowNum, 8).Value) - If hValue <> "" Then - If Len(hValue) <> 1 Then - ws.Cells(rowNum, 2).Value = "H column must be 1 digit" - Exit Sub - End If - If hValue <> "0" And hValue <> "1" Then - ws.Cells(rowNum, 2).Value = "H column must be 0 or 1" - Exit Sub - End If - End If - - ws.Cells(rowNum, 2).ClearContents -End Sub - -Sub Z1_validateButton() - Dim ws As Worksheet - Dim lastRow As Long - Dim r As Long - Dim errorCount As Long - - Set ws = ActiveSheet - lastRow = GetLastDataRow(ws, 3) - - If lastRow < 7 Then - MsgBox "No data found.", vbExclamation - Exit Sub - End If - - errorCount = 0 - For r = 7 To lastRow - Call Z1_validate(ws, r) - If Trim(ws.Cells(r, 2).Value) <> "" Then - errorCount = errorCount + 1 - End If - Next r - - MsgBox "Validation complete. Errors: " & errorCount, vbInformation -End Sub - -Sub Z1_SortDataRowsByC() - Call SortDataRows(3) -End Sub - -Sub Z1_ToggleAutoFilter() - Call ToggleAutoFilter(6) -End Sub - -Sub Z1_AutoFitColumnWidth() - Call AutoFitColumnWidth() +' ====== (222) ======= +Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) + ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents + ws.Cells(rowNum, 2).ClearContents +End Sub + +Sub Z1_Import() + Dim filePath As String + Dim wsTarget As Worksheet + Dim lines As Variant + Dim i As Long + Dim dataArray As Variant + Dim code As String + Dim writeRow As Long + + Set wsTarget = Me + On Error GoTo ErrorHandler + + ' Step 1: Select CSV file + filePath = SelectCSVFile() + If filePath = "" Then Exit Sub + + ' Step 2: Read CSV and return 2D array + lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8") + + ' Step 3: Clear data rows + Call ClearDataRows(wsTarget, 7, 3) + + ' Step 4: Import data + writeRow = 7 + For i = LBound(lines, 1) To UBound(lines, 1) + If Not isRowEmpty Then + wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1))) + wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2))) + wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3))) + wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4))) + wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5))) + wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6))) + wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7))) + + writeRow = writeRow + 1 + End If + Next i + + MsgBox writeRow - 7 & " rows imported.", vbInformation + + Exit Sub + +ErrorHandler: + MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical +End Sub + +Sub Z1_Export() + Dim ws As Worksheet + Dim lastDataRow As Long + Dim savePath As String + Dim r As Long + Dim rowCount As Long + Dim dataArray() As Variant + Dim dataIdx As Long + Dim j As Long + Dim errorCount As Long + + Set ws = ActiveSheet + + lastDataRow = GetLastDataRow(ws, 3) + + If lastDataRow < 7 Then + MsgBox "No data rows to output.", vbExclamation + Exit Sub + End If + + errorCount = 0 + For r = 7 To lastDataRow + Call Z1_validate(ws, r) + If Trim(ws.Cells(r, 2).Value & "") <> "" Then + errorCount = errorCount + 1 + End If + Next r + + If errorCount > 0 Then + MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical + Exit Sub + End If + + savePath = GetSaveCSVPath() + If savePath = "" Then Exit Sub + + ' Count valid rows first (C column non-empty from row 7 onward) + rowCount = 0 + For r = 7 To lastDataRow + If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then + rowCount = rowCount + 1 + End If + Next r + + ' If no data, exit + If rowCount = 0 Then + MsgBox "No data rows to output.", vbExclamation + Exit Sub + End If + + ' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9) + ReDim dataArray(1 To rowCount, 1 To 7) + + ' Fill the array + dataIdx = 0 + For r = 7 To lastDataRow + If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then + dataIdx = dataIdx + 1 + For j = 3 To 9 + dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7 + Next j + End If + Next r + + ' Write using the new array-based CSV writer + Call WriteCSVFromArray(savePath, dataArray, "utf-8", True) + + MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation +End Sub + +Sub Z1_validate(ByVal ws As Worksheet, ByVal rowNum As Long) + Dim cValue As String + cValue = Trim(ws.Cells(rowNum, 3).Value) + + ' clear C~I columns background color + Dim clearRange As Range + Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 9)) + clearRange.Interior.ColorIndex = vbWhite + + If cValue = "" Then + ws.Cells(rowNum, 2).Value = "C column is required" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + If Len(cValue) <> 3 Then + ws.Cells(rowNum, 2).Value = "C column must be 3 characters" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim i As Long + Dim ch As String + For i = 1 To 3 + ch = Mid(cValue, i, 1) + If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then + ws.Cells(rowNum, 2).Value = "C column must be alphanumeric" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next i + + Dim dValue As String + dValue = Trim(ws.Cells(rowNum, 4).Value) + If dValue = "" Then + ws.Cells(rowNum, 2).Value = "D column is required" + ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If Len(dValue) > 80 Then + ws.Cells(rowNum, 2).Value = "D column must be within 80 characters" + ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim eValue As String + eValue = Trim(ws.Cells(rowNum, 5).Value) + If eValue = "" Then + ws.Cells(rowNum, 2).Value = "E column is required" + ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If Len(eValue) > 80 Then + ws.Cells(rowNum, 2).Value = "E column must be within 80 characters" + ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim fValue As String + fValue = Trim(ws.Cells(rowNum, 6).Value) + If fValue <> "" And Len(fValue) > 80 Then + ws.Cells(rowNum, 2).Value = "F column must be within 80 characters" + ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim gValue As String + gValue = Trim(ws.Cells(rowNum, 7).Value) + If gValue <> "" And Len(gValue) > 80 Then + ws.Cells(rowNum, 2).Value = "G column must be within 80 characters" + ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim iValue As String + iValue = Trim(ws.Cells(rowNum, 9).Value) + If iValue <> "" And Len(iValue) > 80 Then + ws.Cells(rowNum, 2).Value = "I column must be within 80 characters" + ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim hValue As String + hValue = Trim(ws.Cells(rowNum, 8).Value) + If hValue <> "" Then + If Len(hValue) <> 1 Then + ws.Cells(rowNum, 2).Value = "H column must be 1 digit" + ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If hValue <> "0" And hValue <> "1" Then + ws.Cells(rowNum, 2).Value = "H column must be 0 or 1" + ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + End If + + ws.Cells(rowNum, 2).ClearContents +End Sub + +Sub Z1_validateButton() + Dim ws As Worksheet + Dim lastRow As Long + Dim r As Long + Dim errorCount As Long + + Set ws = ActiveSheet + lastRow = GetLastDataRow(ws, 3) + + If lastRow < 7 Then + MsgBox "No data found.", vbExclamation + Exit Sub + End If + + errorCount = 0 + For r = 7 To lastRow + Call Z1_validate(ws, r) + If Trim(ws.Cells(r, 2).Value) <> "" Then + errorCount = errorCount + 1 + End If + Next r + + MsgBox "Validation complete. Errors: " & errorCount, vbInformation +End Sub + +Sub Z1_SortDataRowsByC() + Call SortDataRows(3) +End Sub + +Sub Z1_ToggleAutoFilter() + Call ToggleAutoFilter(6) +End Sub + +Sub Z1_AutoFitColumnWidth() + Call AutoFitColumnWidth() End Sub \ No newline at end of file diff --git a/src/thisWorkbook/Master_223.bas b/src/thisWorkbook/Master_223.bas new file mode 100644 index 0000000..849535a --- /dev/null +++ b/src/thisWorkbook/Master_223.bas @@ -0,0 +1,258 @@ +' ====== (223) ======= +Sub Z2_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) + ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents + ws.Cells(rowNum, 2).ClearContents +End Sub + +Sub Z2_Import() + Dim filePath As String + Dim wsTarget As Worksheet + Dim lines As Variant + Dim i As Long + Dim dataArray As Variant + Dim code As String + Dim writeRow As Long + + Set wsTarget = Me + On Error GoTo ErrorHandler + + ' Step 1: Select CSV file + filePath = SelectCSVFile() + If filePath = "" Then Exit Sub + + ' Step 2: Read CSV and return 2D array + lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8") + + ' Step 3: Clear data rows + Call ClearDataRows(wsTarget, 7, 3) + + ' Step 4: Import data + writeRow = 7 + For i = LBound(lines, 1) To UBound(lines, 1) + If Not isRowEmpty Then + wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1))) + wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2))) + wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3))) + wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4))) + wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5))) + wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6))) + wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7))) + + writeRow = writeRow + 1 + End If + Next i + + MsgBox writeRow - 7 & " rows imported.", vbInformation + + Exit Sub + +ErrorHandler: + MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical +End Sub + +Sub Z2_Export() + Dim ws As Worksheet + Dim lastDataRow As Long + Dim savePath As String + Dim r As Long + Dim rowCount As Long + Dim dataArray() As Variant + Dim dataIdx As Long + Dim j As Long + Dim errorCount As Long + + Set ws = ActiveSheet + + lastDataRow = GetLastDataRow(ws, 3) + + If lastDataRow < 7 Then + MsgBox "No data rows to output.", vbExclamation + Exit Sub + End If + + errorCount = 0 + For r = 7 To lastDataRow + Call Z2_validate(ws, r) + If Trim(ws.Cells(r, 2).Value & "") <> "" Then + errorCount = errorCount + 1 + End If + Next r + + If errorCount > 0 Then + MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical + Exit Sub + End If + + savePath = GetSaveCSVPath() + If savePath = "" Then Exit Sub + + ' Count valid rows first (C column non-empty from row 7 onward) + rowCount = 0 + For r = 7 To lastDataRow + If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then + rowCount = rowCount + 1 + End If + Next r + + ' If no data, exit + If rowCount = 0 Then + MsgBox "No data rows to output.", vbExclamation + Exit Sub + End If + + ' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9) + ReDim dataArray(1 To rowCount, 1 To 7) + + ' Fill the array + dataIdx = 0 + For r = 7 To lastDataRow + If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then + dataIdx = dataIdx + 1 + For j = 3 To 9 + dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7 + Next j + End If + Next r + + ' Write using the new array-based CSV writer + Call WriteCSVFromArray(savePath, dataArray, "utf-8", True) + + MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation +End Sub + +Sub Z2_validate(ByVal ws As Worksheet, ByVal rowNum As Long) + Dim cValue As String + cValue = Trim(ws.Cells(rowNum, 3).Value) + + ' clear C~I columns background color + Dim clearRange As Range + Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 9)) + clearRange.Interior.ColorIndex = vbWhite + + If cValue = "" Then + ws.Cells(rowNum, 2).Value = "C column is required" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + If Len(cValue) <> 3 Then + ws.Cells(rowNum, 2).Value = "C column must be 3 characters" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim i As Long + Dim ch As String + For i = 1 To 3 + ch = Mid(cValue, i, 1) + If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then + ws.Cells(rowNum, 2).Value = "C column must be alphanumeric" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next i + + Dim dValue As String + dValue = Trim(ws.Cells(rowNum, 4).Value) + If dValue = "" Then + ws.Cells(rowNum, 2).Value = "D column is required" + ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If Len(dValue) > 80 Then + ws.Cells(rowNum, 2).Value = "D column must be within 80 characters" + ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim eValue As String + eValue = Trim(ws.Cells(rowNum, 5).Value) + If eValue = "" Then + ws.Cells(rowNum, 2).Value = "E column is required" + ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If Len(eValue) > 80 Then + ws.Cells(rowNum, 2).Value = "E column must be within 80 characters" + ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim fValue As String + fValue = Trim(ws.Cells(rowNum, 6).Value) + If fValue <> "" And Len(fValue) > 80 Then + ws.Cells(rowNum, 2).Value = "F column must be within 80 characters" + ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim gValue As String + gValue = Trim(ws.Cells(rowNum, 7).Value) + If gValue <> "" And Len(gValue) > 80 Then + ws.Cells(rowNum, 2).Value = "G column must be within 80 characters" + ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim iValue As String + iValue = Trim(ws.Cells(rowNum, 9).Value) + If iValue <> "" And Len(iValue) > 80 Then + ws.Cells(rowNum, 2).Value = "I column must be within 80 characters" + ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim hValue As String + hValue = Trim(ws.Cells(rowNum, 8).Value) + If hValue <> "" Then + If Len(hValue) <> 1 Then + ws.Cells(rowNum, 2).Value = "H column must be 1 digit" + ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If hValue <> "0" And hValue <> "1" Then + ws.Cells(rowNum, 2).Value = "H column must be 0 or 1" + ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + End If + + ws.Cells(rowNum, 2).ClearContents +End Sub + +Sub Z2_validateButton() + Dim ws As Worksheet + Dim lastRow As Long + Dim r As Long + Dim errorCount As Long + + Set ws = ActiveSheet + lastRow = GetLastDataRow(ws, 3) + + If lastRow < 7 Then + MsgBox "No data found.", vbExclamation + Exit Sub + End If + + errorCount = 0 + For r = 7 To lastRow + Call Z2_validate(ws, r) + If Trim(ws.Cells(r, 2).Value) <> "" Then + errorCount = errorCount + 1 + End If + Next r + + MsgBox "Validation complete. Errors: " & errorCount, vbInformation +End Sub + +Sub Z2_SortDataRowsByC() + Call SortDataRows(3) +End Sub + +Sub Z2_ToggleAutoFilter() + Call ToggleAutoFilter(6) +End Sub + +Sub Z2_AutoFitColumnWidth() + Call AutoFitColumnWidth() +End Sub \ No newline at end of file diff --git a/src/thisWorkbook/Master_224.bas b/src/thisWorkbook/Master_224.bas new file mode 100644 index 0000000..4645742 --- /dev/null +++ b/src/thisWorkbook/Master_224.bas @@ -0,0 +1,258 @@ +' ====== (223) ======= +Sub Z3_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) + ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents + ws.Cells(rowNum, 2).ClearContents +End Sub + +Sub Z3_Import() + Dim filePath As String + Dim wsTarget As Worksheet + Dim lines As Variant + Dim i As Long + Dim dataArray As Variant + Dim code As String + Dim writeRow As Long + + Set wsTarget = Me + On Error GoTo ErrorHandler + + ' Step 1: Select CSV file + filePath = SelectCSVFile() + If filePath = "" Then Exit Sub + + ' Step 2: Read CSV and return 2D array + lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8") + + ' Step 3: Clear data rows + Call ClearDataRows(wsTarget, 7, 3) + + ' Step 4: Import data + writeRow = 7 + For i = LBound(lines, 1) To UBound(lines, 1) + If Not isRowEmpty Then + wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1))) + wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2))) + wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3))) + wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4))) + wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5))) + wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6))) + wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7))) + + writeRow = writeRow + 1 + End If + Next i + + MsgBox writeRow - 7 & " rows imported.", vbInformation + + Exit Sub + +ErrorHandler: + MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical +End Sub + +Sub Z3_Export() + Dim ws As Worksheet + Dim lastDataRow As Long + Dim savePath As String + Dim r As Long + Dim rowCount As Long + Dim dataArray() As Variant + Dim dataIdx As Long + Dim j As Long + Dim errorCount As Long + + Set ws = ActiveSheet + + lastDataRow = GetLastDataRow(ws, 3) + + If lastDataRow < 7 Then + MsgBox "No data rows to output.", vbExclamation + Exit Sub + End If + + errorCount = 0 + For r = 7 To lastDataRow + Call Z3_validate(ws, r) + If Trim(ws.Cells(r, 2).Value & "") <> "" Then + errorCount = errorCount + 1 + End If + Next r + + If errorCount > 0 Then + MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical + Exit Sub + End If + + savePath = GetSaveCSVPath() + If savePath = "" Then Exit Sub + + ' Count valid rows first (C column non-empty from row 7 onward) + rowCount = 0 + For r = 7 To lastDataRow + If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then + rowCount = rowCount + 1 + End If + Next r + + ' If no data, exit + If rowCount = 0 Then + MsgBox "No data rows to output.", vbExclamation + Exit Sub + End If + + ' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9) + ReDim dataArray(1 To rowCount, 1 To 7) + + ' Fill the array + dataIdx = 0 + For r = 7 To lastDataRow + If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then + dataIdx = dataIdx + 1 + For j = 3 To 9 + dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7 + Next j + End If + Next r + + ' Write using the new array-based CSV writer + Call WriteCSVFromArray(savePath, dataArray, "utf-8", True) + + MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation +End Sub + +Sub Z3_validate(ByVal ws As Worksheet, ByVal rowNum As Long) + Dim cValue As String + cValue = Trim(ws.Cells(rowNum, 3).Value) + + ' clear C~I columns background color + Dim clearRange As Range + Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 9)) + clearRange.Interior.ColorIndex = vbWhite + + If cValue = "" Then + ws.Cells(rowNum, 2).Value = "C column is required" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + If Len(cValue) <> 3 Then + ws.Cells(rowNum, 2).Value = "C column must be 3 characters" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim i As Long + Dim ch As String + For i = 1 To 3 + ch = Mid(cValue, i, 1) + If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then + ws.Cells(rowNum, 2).Value = "C column must be alphanumeric" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next i + + Dim dValue As String + dValue = Trim(ws.Cells(rowNum, 4).Value) + If dValue = "" Then + ws.Cells(rowNum, 2).Value = "D column is required" + ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If Len(dValue) > 80 Then + ws.Cells(rowNum, 2).Value = "D column must be within 80 characters" + ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim eValue As String + eValue = Trim(ws.Cells(rowNum, 5).Value) + If eValue = "" Then + ws.Cells(rowNum, 2).Value = "E column is required" + ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If Len(eValue) > 80 Then + ws.Cells(rowNum, 2).Value = "E column must be within 80 characters" + ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim fValue As String + fValue = Trim(ws.Cells(rowNum, 6).Value) + If fValue <> "" And Len(fValue) > 80 Then + ws.Cells(rowNum, 2).Value = "F column must be within 80 characters" + ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim gValue As String + gValue = Trim(ws.Cells(rowNum, 7).Value) + If gValue <> "" And Len(gValue) > 80 Then + ws.Cells(rowNum, 2).Value = "G column must be within 80 characters" + ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim iValue As String + iValue = Trim(ws.Cells(rowNum, 9).Value) + If iValue <> "" And Len(iValue) > 80 Then + ws.Cells(rowNum, 2).Value = "I column must be within 80 characters" + ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim hValue As String + hValue = Trim(ws.Cells(rowNum, 8).Value) + If hValue <> "" Then + If Len(hValue) <> 1 Then + ws.Cells(rowNum, 2).Value = "H column must be 1 digit" + ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If hValue <> "0" And hValue <> "1" Then + ws.Cells(rowNum, 2).Value = "H column must be 0 or 1" + ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + End If + + ws.Cells(rowNum, 2).ClearContents +End Sub + +Sub Z3_validateButton() + Dim ws As Worksheet + Dim lastRow As Long + Dim r As Long + Dim errorCount As Long + + Set ws = ActiveSheet + lastRow = GetLastDataRow(ws, 3) + + If lastRow < 7 Then + MsgBox "No data found.", vbExclamation + Exit Sub + End If + + errorCount = 0 + For r = 7 To lastRow + Call Z3_validate(ws, r) + If Trim(ws.Cells(r, 2).Value) <> "" Then + errorCount = errorCount + 1 + End If + Next r + + MsgBox "Validation complete. Errors: " & errorCount, vbInformation +End Sub + +Sub Z3_SortDataRowsByC() + Call SortDataRows(3) +End Sub + +Sub Z3_ToggleAutoFilter() + Call ToggleAutoFilter(6) +End Sub + +Sub Z3_AutoFitColumnWidth() + Call AutoFitColumnWidth() +End Sub \ No newline at end of file diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index 513e5d0..8a577b7 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ