ファルダにあるすべてのエクセルのファイルから指定した値を取得して、表示させたい

一通りの、ソースは作ったのですが、フォルダにあるすべてのエクセルファイルから、
値を取得して、表示させる方法が分からず、困っております。
このソースをどう改修したらよいでしょうか。お助けお願いします。

Sub 単体テスト仕様書マクロ()

Dim wFile       As String
Dim wFilePath   As String
Dim i           As Long

'Excelファイルが存在していたらファイル名を返す
wFile = Dir(ActiveWorkbook.Path & "*.xlsx")

'先頭行を指定
i = 3

'カレントディレクトリに存在するExcelファイルを全て読み込む
Do While wFile <> ""

    '開くExcelファイルのフルパスを取得
    wFilePath = ActiveWorkbook.Path & "\" & wFile

    '機能（ﾌﾟﾛｸﾞﾗﾑ）名・テスト件数・完了数・不具合件数を取得し配列に格納する（区切り文字：|）
    strData = Split(File_Load(wFilePath), "|")

    '機能（ﾌﾟﾛｸﾞﾗﾑ）名
    Cells(2, 1) = strData(0)

    'テスト件数
    Cells(2, 3) = strData(1)

    '完了数
    Cells(2, 5) = strData(2)

    '不具合件数

    Cells(2, 7) = strData(3)


    '次のExcelファイルを取得
    wFile = Dir()

    '行数をカウント
    i = i + 1

Loop

End Sub


'Excelファイルを開いてデータを取得
Function File_Load(ByVal wFilePath As String) As String

    Dim wb          As Workbook
    Dim wItem       As Variant
    Dim i           As Long
    Dim FoundCell   As Object

    Set wb = Workbooks.Open(wFilePath)

    wItem = Array("機能（ﾌﾟﾛｸﾞﾗﾑ）名", "テスト件数", "完了数", "不具合件数")

    For i = LBound(wItem) To UBound(wItem)

        Set FoundCell = wb.Worksheets(1).Cells.Find(What:=wItem(i))

        If FoundCell Is Nothing Then
            wItem(i) = ""
        Else
            wItem(i) = FoundCell.Offset(, 1).Value
        End If

    Next i

    wb.Close SaveChanges:=False

    File_Load = Join(wItem, "|")

    MsgBox "完了"

End Function

行動規範の内容に同意します

回答1件

ベストアンサー

VBA
1Sub 単体テスト仕様書マクロ()
2
3Dim wFile       As String
4Dim wFilePath   As String
5Dim i           As Long
6
7'Excelファイルが存在していたらファイル名を返す
8wFile = Dir(ActiveWorkbook.Path & "*.xlsx")
9
10'先頭行を指定
11i = 3
12
13Dim ws As Worksheet
14Set ws = ThisWorkbook.Worksheets(1)
15
16'カレントディレクトリに存在するExcelファイルを全て読み込む
17Do While wFile <> ""
18
19    '開くExcelファイルのフルパスを取得
20    wFilePath = ActiveWorkbook.Path & "\" & wFile
21
22    '機能（ﾌﾟﾛｸﾞﾗﾑ）名・テスト件数・完了数・不具合件数を取得し配列に格納する（区切り文字：|）
23    strData = Split(File_Load(wFilePath), "|")
24
25    '機能（ﾌﾟﾛｸﾞﾗﾑ）名
26    ws.Cells(i, 1) = strData(0)
27
28    'テスト件数
29    ws.Cells(i, 3) = strData(1)
30
31    '完了数
32    ws.Cells(i, 5) = strData(2)
33
34    '不具合件数
35    ws.Cells(i, 7) = strData(3)
36
37
38    '次のExcelファイルを取得
39    wFile = Dir()
40
41    '行数をカウント
42    i = i + 1
43
44Loop
45
46End Sub
47
48