Excelからデータを取得するマクロ

Sub aaa()

Call ProcessExcelFiles("C:\Users\toufu\Desktop\4koma")


End Sub


Sub ProcessExcelFiles(folderPath As String)
    Dim fileSystemObject As Object
    Dim folder As Object
    Dim file As Object
    Dim excelApp As Object
    Dim Workbook As Workbook
    Dim summarySheet As Worksheet
    Dim fileName As String
    Dim e5Value, g5Value
    Dim bValue, cValue, anValue
    Dim summary As Double
    Dim i As Integer, j As Integer
    Dim dataArray() As Variant
    Dim dataCount As Integer
    Dim errorMsg As String

    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set folder = fileSystemObject.GetFolder(folderPath)
    Set excelApp = CreateObject("Excel.Application")

    dataCount = 0

    ' Create a new workbook for the summary
    Set summarySheet = ThisWorkbook.Sheets.Add
    summarySheet.Name = "Summary3"

    ' Iterate through each Excel file in the folder
    For Each file In folder.Files
        If file.Name Like "*.xls*" Then
            Set Workbook = excelApp.Workbooks.Open(file.Path)
            With Workbook.Sheets(1)
                ' Get values from E5 and G5
                e5Value = .Range("E5").Value
                g5Value = .Range("G5").Value

                ' Initialize summary
                summary = 0
                i = 20

                ' Process cells from AN20 to AN40
                While .Range("AN" & i).Value <> "" And i <= 40
                    bValue = .Range("B" & i).Value
                    cValue = .Range("C" & i).Value
                    anValue = .Range("AN" & i).Value
                    summary = summary + anValue

                    ' Resize and store the data in the array
                    dataCount = dataCount + 1
                    ReDim Preserve dataArray(1 To 5, 1 To dataCount)
                    dataArray(1, dataCount) = file.Name
                    dataArray(2, dataCount) = e5Value
                    dataArray(3, dataCount) = g5Value
                    dataArray(4, dataCount) = bValue & ", " & cValue & ", " & Format(anValue, "[h]:mm")
                    dataArray(5, dataCount) = summary

                    i = i + 1
                Wend

                ' Check if summary matches AN40
                If summary <> .Range("AN40").Value Then
                    errorMsg = "Error in file: " & file.Name & " - Summary does not match."
                    MsgBox errorMsg
                End If
            End With
            Workbook.Close False
        End If
    Next file

    excelApp.Quit

    ' Write the data to the summary sheet
    If dataCount > 0 Then
        summarySheet.Range("A1").Resize(UBound(dataArray, 2), UBound(dataArray, 1)).Value = Application.WorksheetFunction.Transpose(dataArray)
    End If
End Sub

Sub vvv()
 bbb = 時間を分に変換("20:15") + 時間を分に変換("23:00")
End Sub


Function 時間を分に変換(cellValue As String) As Double
    Dim 時間 As Double
    Dim 分 As Double
    
    ' 時間と分に分割
    If InStr(cellValue, ":") > 0 Then
        時間 = Val(Left(cellValue, InStr(cellValue, ":") - 1))
        分 = Val(Mid(cellValue, InStr(cellValue, ":") + 1))
    Else
        ' 有効な時間形式でない場合、エラー値を返す
        時間を分に変換 = CVErr(xlErrValue)
        Exit Function
    End If
    
    ' 時間を分に変換し、小数に変換して返す
    時間を分に変換 = (時間 * 60 + 分) / 60 ' 分を小数に変換
End Function