LoginSignup
0
0

VBA

Last updated at Posted at 2024-05-16

1. CSVファイルの読み込み関数

まず、CSVファイルを読み込む関数を定義します。

Function ReadCSV(ByVal filePath As String) As Variant
    Dim fso As Object
    Dim ts As Object
    Dim content As String
    Dim lines As Variant
    
    ' Create FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' Open the file as binary
    Set ts = fso.OpenTextFile(filePath, 1, False, -1)
    ' Read the file content
    content = ts.ReadAll
    ' Close the file
    ts.Close
    
    ' Replace all possible line endings with vbCrLf
    content = Replace(content, vbCrLf, vbLf) ' Convert CRLF to LF
    content = Replace(content, vbCr, vbLf)   ' Convert CR to LF
    
    ' Split the content by LF
    lines = Split(content, vbLf)
    
    ReadCSV = lines
End Function

2. ヘッダーからID列のインデックスを取得する関数

次に、ヘッダーから「社員番号」列のインデックスを取得する関数を定義します。

Function GetIDColumnIndex(headerRow As String, columnName As String) As Integer
    Dim columns As Variant
    Dim i As Integer
    
    ' ヘッダー行をカンマで分割
    columns = Split(headerRow, ",")
    
    ' 指定された列名のインデックスを取得
    For i = LBound(columns) To UBound(columns)
        If Trim(columns(i)) = columnName Then
            GetIDColumnIndex = i
            Exit Function
        End If
    Next i
    
    ' 見つからなかった場合はエラー
    GetIDColumnIndex = -1
End Function

3. コメント行をスキップする関数

次に、コメント行をスキップして最初のデータ行を取得する関数を定義します。

Function GetFirstDataLine(data As Variant) As String
    Dim i As Integer
    
    ' データ行を探す
    For i = 1 To UBound(data)
        If Left(Trim(data(i)), 1) <> "#" Then
            GetFirstDataLine = data(i)
            Exit Function
        End If
    Next i
    
    ' データ行が見つからない場合は空文字列を返す
    GetFirstDataLine = ""
End Function

4. 最終データ行を取得する関数

次に、最終データ行を取得する関数を定義します。

Function GetLastDataLine(data As Variant) As String
    Dim i As Integer
    
    ' 最終データ行を探す
    For i = UBound(data) To 1 Step -1
        If Left(Trim(data(i)), 1) <> "#" Then
            GetLastDataLine = data(i)
            Exit Function
        End If
    Next i
    
    ' データ行が見つからない場合は空文字列を返す
    GetLastDataLine = ""
End Function

5. フォルダ内のファイルを取得する関数

次に、フォルダ内のCSVファイルを取得する関数を定義します。

Function GetCSVFiles(folderPath As String) As Collection
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim files As New Collection
    
    ' Create FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' Get the folder
    Set folder = fso.GetFolder(folderPath)
    
    ' Loop through each file in the folder
    For Each file In folder.Files
        If LCase(fso.GetExtensionName(file.Name)) = "csv" Then
            files.Add file.Path
        End If
    Next file
    
    ' Return the collection of file paths
    Set GetCSVFiles = files
End Function

6. ファイル連続性のチェックサブルーチン

最後に、フォルダ内のファイルを順番に取得し、連続性をチェックするサブルーチンを定義します。

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
    
    ' 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 = Trim(Split(currentLine, ",")(idColumnIndex))
        
        ' 社員番号を比較
        If prevID <> currentID Then
            Debug.Print "Error between file " & Format(i, "000") & ".csv and " & Format(i + 1, "000") & ".csv"
            errorCount = errorCount + 1
        End If
    Next i
    
    Debug.Print "Total errors found: " & errorCount
End Sub

7. 実行方法

  1. ExcelシートのC2セルにCSVファイルが格納されているフォルダのパスを入力します。
  2. VBAエディタを開き、標準モジュールに上記のコードを貼り付けます。
  3. CheckCSVFilesサブルーチンを実行します。

このコードは、C2セルから取得したフォルダパス内のCSVファイルを順番に読み込み、前ファイルの最終行の社員番号と次ファイルの最初の行の社員番号を比較し、連続性をチェックします。行の先頭が # の場合、その行をコメント行として無視します。

0
0
1

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