在MS Excel中搜索多个工作簿以获取值计数

时间:2014-06-09 23:24:25

标签: excel excel-vba vba

在不久的将来世界杯,我正在运行一个游泳池并想计算统计数据。 我在文件夹C:\ WorldCup

中有几百个Excel电子表格

每个电子表格都是一样的 在每个电子表格中,预计获胜者都在单元格中:STEP2!N17

我想要一个电子表格,可以搜索一百个XLS文件并返回一个值计数

德国34 西班牙20 美国10 意大利1

...等

1 个答案:

答案 0 :(得分:0)

我在很大程度上找到了答案。这将从已关闭的工作簿中返回该单元格中的所有值

Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, i As Integer
    FolderName = "C:\Users\GARING\Documents\MyWorldCup\2014\2014Entries"
    ' create list of workbooks in foldername
    wbCount = 0
    wbName = Dir(FolderName & "\" & "*.xls")
    While wbName <> ""
        wbCount = wbCount + 1
        ReDim Preserve wbList(1 To wbCount)
        wbList(wbCount) = wbName
        wbName = Dir
    Wend
    If wbCount = 0 Then Exit Sub
    ' get values from each workbook
    r = 0
    Workbooks.Add
    For i = 1 To wbCount
        r = r + 1
        cValue = GetInfoFromClosedFile(FolderName, wbList(i), "STEP2", "N17")
        Cells(r, 1).Formula = wbList(i)
        Cells(r, 2).Formula = cValue
    Next i
End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
    wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
    GetInfoFromClosedFile = ""
    If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
    If Dir(wbPath & "\" & wbName) = "" Then Exit Function
    arg = "'" & wbPath & "[" & wbName & "]" & _
        wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
    On Error Resume Next
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function