LoginSignup
0
0

VBA2

Last updated at Posted at 2024-05-16

Sub CheckCSVFiles()
    Dim folderPath As String
    Dim fileNames As Collection
    Dim fileCount As Integer
    Dim i As Integer
    Dim prevID As String
    Dim currentID As String
    Dim prevFileData As Variant
    Dim currentFileData As Variant
    Dim header As String
    Dim idColumnIndex As Integer
    Dim prevLine As String
    Dim currentLine As String
    Dim errorCount As Integer
    Dim sortedFiles As Collection
    Dim appendedLines As New Collection
    
    ' C2セルからフォルダパスを取得
    folderPath = Range("C2").Value
    If Right(folderPath, 1) <> "\" Then
        folderPath = folderPath & "\"
    End If
    
    ' CSVファイルのリストを取得
    Set fileNames = GetCSVFiles(folderPath)
    fileCount = fileNames.Count
    
    ' ソートされたファイルのリストを作成
    Set sortedFiles = New Collection
    For i = 1 To fileCount
        For Each fileName In fileNames
            If InStr(fileName, Format(i, "000")) > 0 Then
                sortedFiles.Add fileName
                Exit For
            End If
        Next fileName
    Next i
    
    ' 連続性チェック
    errorCount = 0
    
    For i = 1 To sortedFiles.Count - 1
        ' ファイル名を取得
        prevFileName = sortedFiles(i)
        currentFileName = sortedFiles(i + 1)
        
        ' 前のファイルを読み込む
        prevFileData = ReadCSV(prevFileName)
        ' 現在のファイルを読み込む
        currentFileData = ReadCSV(currentFileName)
        
        ' ヘッダー行を取得
        header = prevFileData(0)
        ' 社員番号列のインデックスを取得
        idColumnIndex = GetIDColumnIndex(header, "社員番号")
        
        ' 社員番号列が見つからない場合はエラーメッセージを表示して終了
        If idColumnIndex = -1 Then
            Debug.Print "社員番号 column not found in " & prevFileName
            Exit Sub
        End If
        
        ' 前のファイルの最終行の社員番号を取得
        prevLine = GetLastDataLine(prevFileData)
        prevID = Trim(Split(prevLine, ",")(idColumnIndex))
        
        ' 現在のファイルの最初の行の社員番号を取得
        currentLine = GetFirstDataLine(currentFileData)
        currentID = Range("C3").Value
        
        ' 社員番号を比較
        If prevID <> currentID Then
            ' 前のファイルに追加
            appendedLines.Add currentLine
            ' 次のファイルから削除
            currentFileData(1) = ""
            ' エラーカウントをインクリメント
            errorCount = errorCount + 1
        End If
    Next i
    
    ' 追加した行を前のファイルに書き込む
    If appendedLines.Count > 0 Then
        Dim fso As Object
        Dim ts As Object
        
        ' Create FileSystemObject
        Set fso = CreateObject("Scripting.FileSystemObject")
        ' Open the previous file for appending
        Set ts = fso.OpenTextFile(prevFileName, 8, True, -1)
        
        ' Write the appended lines
        For Each line In appendedLines
            ts.WriteLine line
        Next line
        
        ' Close the file
        ts.Close
    End If
    
    Debug.Print "Total errors found: " & errorCount
End Sub
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0