取数

lgzxmlg

提取文件夹内数据 取数.zip (100.03 KB, 下载次数: 22)

2022-11-15 17:54 上传

点击文件名下载附件

liulang0808

https://club.excelhome.net/thread-1613618-1-1.html
文件对象的案例，楼主可以参考下

shiruiqiang

学习楼上大侠的，练练题吧Sub text()
Dim fso
Dim x, y, k
Dim arr, brr(1 To 100000, 1 To 32)
Set fso = CreateObject("scripting.filesystemobject")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each f In fso.getfolder(ThisWorkbook.Path).Files
        If InStr(f.Name, ThisWorkbook.Name) = 0 Then
            With Workbooks.Open(f)
                arr = .Sheets(1).UsedRange
                .Close False
            End With
            For x = 2 To UBound(arr)
                If InStr(arr(x, 1), "Average") > 0 Then
                    k = k + 1
                    brr(k, 1) = arr(2, 1)
                    For y = 2 To UBound(arr, 2)
                    brr(k, y) = arr(x, y)
                    Next
                    Exit For
                End If
            Next
        End If
    Next
    Sheets(1).Range("a6:af100000").ClearContents
    Sheets(1).[a6].Resize(k, UBound(brr, 2)) = brr
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

lgzxmlg

shiruiqiang 发表于 2022-11-15 22:15
学习楼上大侠的，练练题吧Sub text()
Dim fso
Dim x, y, k

谢谢老师。正是要的结果。

dodiy1986

谢谢老师。