vba/vba_code_kotsu_master.bas

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_ImportMasterDetailData()
    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_ExportMasterDetailData()
    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_validateDetailData(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_validateDetailDataButton()
    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_validateDetailData(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