diff --git a/src/module/Module_Common.bas b/src/module/Module_Common.bas index 8bf0f9b..62f3fe3 100644 --- a/src/module/Module_Common.bas +++ b/src/module/Module_Common.bas @@ -22,6 +22,116 @@ Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row End Function +' @return dict : key = keyCol,value = Array +' @param sheetName +' @param keyCol +' @param valueCols Array(4,5,6) +' @param startRow default is 7 +Function LoadLookup( _ + ByVal sheetName As String, _ + ByVal keyCol As Long, _ + ByVal valueCols As Variant, _ + Optional ByVal startRow As Long = 7 _ +) As Object + + ' --- validate --- + If Trim(sheetName) = "" Then Exit Function + If Not IsArray(valueCols) Then + valueCols = Array(valueCols) + End If + Dim nValCols As Long: nValCols = UBound(valueCols) - LBound(valueCols) + 1 + If nValCols = 0 Then Exit Function + + ' --- obtain worksheet --- + On Error Resume Next + Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(sheetName) + On Error GoTo 0 + If ws Is Nothing Then Exit Function + + ' --- obtain data(based on keyCol)--- + Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row + If lastRow < startRow Then Exit Function + + ' --- 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 + Dim colNum As Long: colNum = CLng(valueCols(i)) + If colNum < 1 Then Exit Function + If colNum < minCol Then minCol = colNum + If colNum > maxCol Then maxCol = colNum + Next i + + ' --- read --- + Dim dataRange As Range + Set dataRange = ws.Range(ws.Cells(startRow, minCol), ws.Cells(lastRow, maxCol)) + Dim data As Variant: data = dataRange.Value + + ' --- Ensure data is a 2D array --- + If Not IsArray(data) Then + ' Single cell case + Dim temp As Variant + ReDim temp(1 To 1, 1 To (maxCol - minCol + 1)) + temp(1, 1) = data + data = temp + End If + + ' --- build --- + Dim keyOffset As Long: keyOffset = keyCol - minCol + 1 + Dim valOffsets() As Long: ReDim valOffsets(0 To nValCols - 1) + For i = 0 To nValCols - 1 + valOffsets(i) = valueCols(LBound(valueCols) + i) - minCol + 1 + Next i + + ' --- write into --- + Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary") + dict.CompareMode = vbTextCompare + + Dim r As Long + For r = 1 To UBound(data, 1) + Dim key As String: key = Trim(data(r, keyOffset)) + If key <> "" Then + Dim vals() As String: ReDim vals(0 To nValCols - 1) + Dim j As Long + For j = 0 To nValCols - 1 + vals(j) = Trim(data(r, valOffsets(j))) + Next j + dict(key) = vals + End If + Next r + + Set LoadLookup = dict +End Function + +Function GetLastDataRowInRange(ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, Optional ByVal startRow As Long = 7) As Long + ' --- validate --- + If startCol < 1 Then + Err.Raise 1001, "GetLastDataRowInRange", "startCol must >= 1" + End If + If endCol < 1 Then + Err.Raise 1002, "GetLastDataRowInRange", "endCol must >= 1" + End If + If endCol < startCol Then + Err.Raise 1003, "GetLastDataRowInRange", "endCol must >= startCol" + End If + If startRow < 1 Then + Err.Raise 1004, "GetLastDataRowInRange", "startRow must >= 1" + End If + + ' --- query max row --- + Dim colIndex As Long, lastRow As Long, maxRow As Long + + maxRow = startRow - 1 + For colIndex = startCol To endCol + lastRow = ws.Cells(ws.Rows.Count, colIndex).End(xlUp).Row + If lastRow > maxRow Then maxRow = lastRow + Next colIndex + + GetLastDataRowInRange = maxRow +End Function + Sub ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum As Long) Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row diff --git a/src/thisWorkbook/Master_M1_Kukan.bas b/src/thisWorkbook/Master_M1_Kukan.bas index de7e87f..4831f45 100644 --- a/src/thisWorkbook/Master_M1_Kukan.bas +++ b/src/thisWorkbook/Master_M1_Kukan.bas @@ -1,189 +1,143 @@ -' CSV Header Constants +' ====== (222) ======= + +' ====== Constants ====== +Const START_COL As Long = 3 +Const END_COL As Long = 14 + +Private z1Cache As Object ' + +' ====== Function ====== +Public Sub RefreshZ1Cache() + Set z1Cache = LoadLookup("Z1", keyCol:=3, valueCols:=Array(4), startRow:=7) +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 + + For i = 1 To 12 + headerArr(1, i) = Trim(ws.Cells(5, i + 2).Value) ' i+2: 1→3(C), 12→14(N) + Next i + + GetM1CSVHeader = headerArr +End Function Private Sub Worksheet_Change(ByVal Target As Range) - ' === Fill D, E when C column changes === - If Target.Column = 3 And Target.Row >= 7 Then + ' === Fill D, E columns when C column changes === + If Target.Column = 4 And Target.Row >= 7 Then + If z1Cache Is Nothing Then Call RefreshZ1Cache + Dim cell As Range For Each cell In Target - If Trim(cell.Value) = "" Then - Call ClearRowData(Me, cell.Row) + Dim dVal As String: dVal = Trim(cell.Value) + If dVal = "" Then + Me.Cells(cell.Row, 5).ClearContents Else - Call FillFromZ1(Me, cell.Row) + If Not z1Cache Is Nothing And z1Cache.Exists(dVal) Then + Dim vals As Variant: vals = z1Cache(dVal) + Me.Cells(cell.Row, 5).Value = vals(0) + Else + Me.Cells(cell.Row, 5).ClearContents + End If End If Next End If End Sub -Sub FillFromZ1(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal setG As Boolean = True) - Dim wsZ1 As Worksheet - Dim lastRow As Long - Dim i As Long - Dim code As String - - On Error Resume Next - Set wsZ1 = ThisWorkbook.Worksheets("Z1") - If wsZ1 Is Nothing Then Exit Sub - On Error GoTo 0 - code = Trim(ws.Cells(rowNum, 3).Value) - If code = "" Then Exit Sub - lastRow = wsZ1.Cells(wsZ1.rows.Count, 3).End(xlUp).Row - - For i = 7 To lastRow - If Trim(wsZ1.Cells(i, 7).Value) = code Then - ws.Cells(rowNum, 4).Value = Trim(wsZ1.Cells(i, 4).Value) - ws.Cells(rowNum, 4).Value = Trim(wsZ1.Cells(i, 4).Value) - ws.Cells(rowNum, 5).Value = Trim(wsZ1.Cells(i, 6).Value) - ws.Cells(rowNum, 6).Value = Trim(wsZ1.Cells(i, 7).Value) - ws.Cells(rowNum, 7).Value = Trim(wsZ1.Cells(i, 9).Value) - If setG Then - ws.Cells(rowNum, 7).Value = "1" - End If - Exit Sub - End If - Next - - Call ClearRowData(ws, rowNum) +Sub FillFromZ1(ByVal rowNum As Long) + Dim ws As Worksheet: Set ws = ActiveSheet + Dim code As String: code = Trim(ws.Cells(rowNum, 3).Value) + If code = "" Then + Call ClearRowData(ws, rowNum) + Exit Sub + End If + + If z1Cache Is Nothing Then Call RefreshZ1Cache + If z1Cache Is Nothing Then Exit Sub + + If z1Cache.Exists(code) Then + Dim vals As Variant: vals = z1Cache(code) + + ws.Cells(rowNum, 4).Value = vals(0) + ws.Cells(rowNum, 5).Value = vals(1) + Else + Call ClearRowData(ws, rowNum) + End If End Sub Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) - ' Clear from D column onwards + ' Clear columns D onwards ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents ws.Cells(rowNum, 6).Validation.Delete - ws.Cells(rowNum, 19).ClearContents ' Q column error info + ws.Cells(rowNum, 19).ClearContents ' Column Q - error info End Sub Sub M1_Import() - 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 csvData As Variant Dim i As Long - Dim dataArray As Variant - Dim code As String - Dim lastRow As Long - Dim r As Long + Dim writeRow As Long + ' Target this worksheet Set wsTarget = Me ' === 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 + Dim filePath As String + filePath = SelectCSVFile() + If filePath = "" Then Exit Sub - ' === 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 + ' === Step 2: Read CSV with Shift-JIS (using common function) === + On Error GoTo ImportError + csvData = ReadCSVAs2DArrayStrict(filePath, 12, "shift_jis", False) + On Error GoTo 0 ' === Clear all data rows before import === - lastRow = wsTarget.Cells(wsTarget.rows.Count, "C").End(xlUp).Row + Dim lastRow As Long + lastRow = wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Row If lastRow >= 7 Then - wsTarget.Range("A7:P" & lastRow).ClearContents + wsTarget.Range("A7:N" & lastRow).ClearContents End If - If UBound(lines) < 1 Then + 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 === + ' === Step 3: Write CSV data to worksheet (forward order) === writeRow = 7 - For i = 1 To UBound(lines) - If Trim(lines(i)) = "" Then GoTo NextLine + 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))) + Next j - 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 - - - writeRow = writeRow + 1 -NextLine: + ' Auto-fill D, E columns from Z1 + ' Call FillFromZ1(wsTarget, writeRow, False) + + writeRow = writeRow + Next i MsgBox writeRow - 7 & " rows imported.", vbInformation + Exit Sub + +ImportError: + MsgBox "CSV import failed: " & Err.Description, vbExclamation End Sub -Sub validate(ByVal ws As Worksheet, ByVal rowNum As Long) +Sub validate(ByVal rowNum As Long) + Set ws = Me + ' 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) + ' Check G (column 9), H (column 10) 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 @@ -194,13 +148,13 @@ Sub validate(ByVal ws As Worksheet, ByVal rowNum As Long) Exit Sub End If - ' Check I (K column) required + ' Check I (column 11) 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 + ' Check J (column 12), K (column 13) 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 @@ -211,7 +165,7 @@ Sub validate(ByVal ws As Worksheet, ByVal rowNum As Long) Exit Sub End If - ' Check L-P optional but must be numeric if entered + ' Check L-P (columns 14-18) optional but must be numeric if entered Dim col As Long Dim colName As String Dim colLetter As String @@ -225,7 +179,7 @@ Sub validate(ByVal ws As Worksheet, ByVal rowNum As Long) End If Next col - ' Check GH composite key duplicate + ' Check G-H composite key for duplicates Dim g As String, h As String Dim r As Long Dim lastRow As Long @@ -233,7 +187,7 @@ Sub validate(ByVal ws As Worksheet, ByVal rowNum 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 + 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 @@ -244,20 +198,19 @@ Sub validate(ByVal ws As Worksheet, ByVal rowNum As Long) End If Next r - ' Validation passed + ' Validation passed - clear error ws.Cells(rowNum, 19).ClearContents End Sub -' Button macro (Validate selected row) Sub validateButton() 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 + Set ws = Me + lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row If lastRow < 7 Then MsgBox "No data found.", vbExclamation @@ -266,81 +219,110 @@ Sub validateButton() errorCount = 0 For r = 7 To lastRow - Call validateDetailData(ws, r) - If Trim(ws.Cells(r, 17).Value) <> "" Then + Call validate(ws, r) + If Trim(ws.Cells(r, 19).Value) <> "" Then errorCount = errorCount + 1 End If Next r - MsgBox "Validation complete. Errors: " & errorCount & ", ", vbInformation + MsgBox "Validation complete. Errors: " & errorCount, vbInformation End Sub Sub M1_Export() - Dim ws As Worksheet - Set ws = ActiveSheet - - Dim lastDataRow As Long - lastDataRow = ws.Cells(ws.rows.Count, "C").End(xlUp).Row - + 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 ws As Worksheet + Set ws = Me - 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 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(ws, r) + If Trim(ws.Cells(r, 19).Value) <> "" Then + errorCount = errorCount + 1 + End If End If Next r - ' Trim trailing empty lines - Do While Right(csvContent, 1) = vbLf - csvContent = Left(csvContent, Len(csvContent) - 1) - Loop + If errorCount > 0 Then + MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical + Exit Sub + End If - ' 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 + ' === Step 2: Select save path === + Dim savePath As String + savePath = GetSaveCSVPath() + If savePath = "" Then Exit Sub + + ' === Step 3: Get header from row 5 (C-N columns) === + Dim headerArr As Variant + headerArr = GetM1CSVHeader(ws) + + ' === Step 4: Build data array (skip D, E, F columns) === + Dim dataArr As Variant + Dim rowCount As Long + 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 rowCount = 0 Then + MsgBox "No data rows to output.", vbExclamation + Exit Sub + End If + + ReDim dataArr(1 To rowCount, 1 To 12) + + Dim dataRow As Long + dataRow = 0 + For r = 7 To lastDataRow + If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then + dataRow = dataRow + 1 + ' CSV col1 -> C column + dataArr(dataRow, 1) = CleanCSVField(ws.Cells(r, 3).Value) + ' CSV col2-12 -> G-N column (columns 7-14) + Dim j As Long + For j = 7 To 14 + dataArr(dataRow, j - 6) = CleanCSVField(ws.Cells(r, j).Value) + Next j + End If + Next r + + ' === Step 5: Write to CSV (using common function) === + Dim outputArr As Variant + ReDim outputArr(1 To rowCount + 1, 1 To 12) + + ' Copy header to first row + Dim colIdx As Long + For colIdx = 1 To 12 + outputArr(1, colIdx) = headerArr(1, colIdx) + Next colIdx + + ' Copy data to remaining rows + Dim dataR As Long + For dataR = 1 To rowCount + For colIdx = 1 To 12 + outputArr(dataR + 1, colIdx) = dataArr(dataR, colIdx) + Next colIdx + Next dataR + + 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 M1_SortDataRowsByC() diff --git a/src/thisWorkbook/Master_Z1_222.bas b/src/thisWorkbook/Master_Z1_222.bas index b467aa6..15ac97a 100644 --- a/src/thisWorkbook/Master_Z1_222.bas +++ b/src/thisWorkbook/Master_Z1_222.bas @@ -1,4 +1,10 @@ ' ====== (222) ======= + +' ====== Constants ====== +Const START_COL As Long = 3 +Const END_COL As Long = 9 + +' ====== Function ====== Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) Call Generic_Master_ClearRowData(ws, rowNum) End Sub @@ -8,15 +14,14 @@ Sub Z1_Import() End Sub Sub Z1_Export() - Dim lastDataRow As Long: lastDataRow = GetLastDataRow(Me, 3) + 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 r As Long - Dim errorCount As Long + Dim r As Long, errorCount As Long For r = 7 To lastDataRow Validate r If Trim(Cells(r, 2).Value & "") <> "" Then @@ -33,14 +38,12 @@ Sub Z1_Export() End Sub Sub Validate(ByVal rowNum As Long) - Dim cValue As String Set ws = Me - - cValue = Trim(ws.Cells(rowNum, 3).Value) + 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)) + Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) clearRange.Interior.Color = vbWhite If cValue = "" Then @@ -135,19 +138,16 @@ Sub Validate(ByVal rowNum As Long) End Sub Sub Z1_validateButton() - Dim lastRow As Long - Dim r As Long - Dim errorCount As Long + Dim lastDataRow As Long, r As Long, errorCount As Long + lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - lastRow = GetLastDataRow(Me, 3) - - If lastRow < 7 Then + If lastDataRow < 7 Then MsgBox "No data found.", vbExclamation Exit Sub End If errorCount = 0 - For r = 7 To lastRow + For r = 7 To lastDataRow Validate r If Trim(Cells(r, 2).Value) <> "" Then errorCount = errorCount + 1 @@ -166,5 +166,5 @@ Sub Z1_ToggleAutoFilter() End Sub Sub Z1_AutoFitColumnWidth() - Call AutoFitColumnWidth(2, 9) + Call AutoFitColumnWidth(2, END_COL) End Sub \ No newline at end of file diff --git a/src/thisWorkbook/Master_Z2_223.bas b/src/thisWorkbook/Master_Z2_223.bas index 12bbeb3..c58f314 100644 --- a/src/thisWorkbook/Master_Z2_223.bas +++ b/src/thisWorkbook/Master_Z2_223.bas @@ -1,4 +1,10 @@ ' ====== (223) ======= + +' ====== Constants ====== +Const START_COL As Long = 3 +Const END_COL As Long = 7 + +' ====== Function ====== Sub Z2_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) Call Generic_Master_ClearRowData(ws, rowNum) End Sub @@ -8,15 +14,14 @@ Sub Z2_Import() End Sub Sub Z2_Export() - Dim lastDataRow As Long: lastDataRow = GetLastDataRow(Me, 3) + 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 r As Long - Dim errorCount As Long + Dim r As Long, errorCount As Long For r = 7 To lastDataRow Validate r If Trim(Cells(r, 2).Value & "") <> "" Then @@ -33,14 +38,12 @@ Sub Z2_Export() End Sub Sub Validate(ByVal rowNum As Long) - Dim cValue As String Set ws = Me - - cValue = Trim(ws.Cells(rowNum, 3).Value) + 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, 7)) + Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) clearRange.Interior.Color = vbWhite If cValue = "" Then @@ -119,19 +122,16 @@ Sub Validate(ByVal rowNum As Long) End Sub Sub Z2_validateButton() - Dim lastRow As Long - Dim r As Long - Dim errorCount As Long + Dim lastDataRow As Long, r As Long, errorCount As Long + lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - lastRow = GetLastDataRow(Me, 3) - - If lastRow < 7 Then + If lastDataRow < 7 Then MsgBox "No data found.", vbExclamation Exit Sub End If errorCount = 0 - For r = 7 To lastRow + For r = 7 To lastDataRow Validate r If Trim(Cells(r, 2).Value) <> "" Then errorCount = errorCount + 1 @@ -150,5 +150,5 @@ Sub Z2_ToggleAutoFilter() End Sub Sub Z2_AutoFitColumnWidth() - Call AutoFitColumnWidth(2, 7) + Call AutoFitColumnWidth(2, END_COL) End Sub \ No newline at end of file diff --git a/src/thisWorkbook/Master_Z3_224.bas b/src/thisWorkbook/Master_Z3_224.bas index 9af102a..8fc4847 100644 --- a/src/thisWorkbook/Master_Z3_224.bas +++ b/src/thisWorkbook/Master_Z3_224.bas @@ -1,4 +1,10 @@ ' ====== (224) ======= + +' ====== Constants ====== +Const START_COL As Long = 3 +Const END_COL As Long = 8 + +' ====== Function ====== Sub Z3_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) Call Generic_Master_ClearRowData(ws, rowNum) End Sub @@ -8,15 +14,14 @@ Sub Z3_Import() End Sub Sub Z3_Export() - Dim lastDataRow As Long: lastDataRow = GetLastDataRow(Me, 3) + 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 r As Long - Dim errorCount As Long + Dim r As Long, errorCount As Long For r = 7 To lastDataRow Validate r If Trim(Cells(r, 2).Value & "") <> "" Then @@ -33,14 +38,12 @@ Sub Z3_Export() End Sub Sub Validate(ByVal rowNum As Long) - Dim cValue As String Set ws = Me - - cValue = Trim(ws.Cells(rowNum, 3).Value) + 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, 8)) + Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) clearRange.Interior.Color = vbWhite If cValue = "" Then @@ -127,19 +130,16 @@ Sub Validate(ByVal rowNum As Long) End Sub Sub Z3_validateButton() - Dim lastRow As Long - Dim r As Long - Dim errorCount As Long - - lastRow = GetLastDataRow(Me, 3) - - If lastRow < 7 Then + 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 + For r = 7 To lastDataRow Validate r If Trim(Cells(r, 2).Value) <> "" Then errorCount = errorCount + 1 @@ -158,5 +158,5 @@ Sub Z3_ToggleAutoFilter() End Sub Sub Z3_AutoFitColumnWidth() - Call AutoFitColumnWidth(2, 8) + Call AutoFitColumnWidth(2, END_COL) End Sub \ No newline at end of file diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index efb9d88..5d0ca6d 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ