vba/vba_code_kotsu_master.txt

Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
    ' Clear from D column onwards
    ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
    ws.Cells(rowNum, 2).ClearContents ' Q column error info
End Sub

Sub Z1_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
    
    ' === 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)
    
    ' === First: validate all data rows have exactly 7 columns ===
    Dim validRowCount As Long
    Dim lineNum As Long
    validRowCount = 0
    For lineNum = 0 To UBound(lines)
        If Trim(lines(lineNum)) <> "" Then
            dataArray = Split(lines(lineNum), ",")
            If UBound(dataArray) + 1 <> 7 Then
                MsgBox "CSV line " & (lineNum + 1) & " has " & (UBound(dataArray) + 1) & " columns. Expected 7.", vbExclamation
                Exit Sub
            End If
            validRowCount = validRowCount + 1
        End If
    Next lineNum
    
    If validRowCount = 0 Then
        MsgBox "No valid data in CSV.", vbExclamation
        Exit Sub
    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
        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 = 0 To UBound(lines)
        If Trim(lines(i)) = "" Then GoTo NextCsvLine
        dataArray = Split(lines(i), ",")
        If UBound(dataArray) >= 0 Then
            code = Z1_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 = 0 To UBound(lines)
        If Trim(lines(i)) = "" Then GoTo NextLine
        
        dataArray = Split(lines(i), ",")
        
        ' CSV col1-7 -> C-I column (3-9)
        wsTarget.Cells(writeRow, 3).Value = Z1_CleanCSVField(CStr(dataArray(0)))
        wsTarget.Cells(writeRow, 4).Value = Z1_CleanCSVField(CStr(dataArray(1)))
        wsTarget.Cells(writeRow, 5).Value = Z1_CleanCSVField(CStr(dataArray(2)))
        wsTarget.Cells(writeRow, 6).Value = Z1_CleanCSVField(CStr(dataArray(3)))
        wsTarget.Cells(writeRow, 7).Value = Z1_CleanCSVField(CStr(dataArray(4)))
        wsTarget.Cells(writeRow, 8).Value = Z1_CleanCSVField(CStr(dataArray(5)))
        wsTarget.Cells(writeRow, 9).Value = Z1_CleanCSVField(CStr(dataArray(6)))

        writeRow = writeRow + 1
NextLine:
    Next i
    
    MsgBox writeRow - 7 & " rows imported.", vbInformation
End Sub

Function Z1_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 Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
    ' Check C column - must be 3-digit alphanumeric, required
    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
    
    ' Check D column - must be within 80 full-width characters, required
    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
    
    ' Check E column - must be within 80 full-width characters, required
    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
    
    ' Check F column - must be within 80 full-width characters, optional
    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
    
    ' Check G column - must be within 80 full-width characters, optional
    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
    
    ' Check I column - must be within 80 full-width characters, optional
    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
    
    ' Check H column - 1 digit, 0 or 1, optional
    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
    
    ' Validation passed
    ws.Cells(rowNum, 2).ClearContents
End Sub


' Button macro (Validate selected row)
Sub Z1_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
        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_ExportMasterDetailData()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    Dim lastDataRow As Long
    lastDataRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    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
    For r = 7 To lastDataRow
        If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
            rowCount = rowCount + 1
            ' CSV col1 -> C column
            csvContent = csvContent & Z1_CleanCSVField(ws.Cells(r, 3).Value)
            ' CSV col2-11 -> I-R column
            For j = 9 To 18
                csvContent = csvContent & "," & Z1_CleanCSVField(ws.Cells(r, j).Value)
            Next j
            csvContent = csvContent & vbLf
        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
    
    MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
End Sub