Excel VBA 宏以匹配根文件夾中工作簿中的單元格值，然后復制特定單元格

Question

上圖是主工作簿。 任何人都可以幫助我編寫 vba，以便它會在整個根文件夾（例如 C:\\Work\\2017）中找到與帳號匹配的工作簿，並將 B9 和 E9 單元格復制到主單元格。 第二張圖片是一個系統生成的工作簿，具有隨機名稱（例如 export!-097a0sdk.xls），這就是為什么我需要一個快捷方式來使這個任務更容易。

這是我使用代碼預期的結果

這是系統生成的excel

謝謝

Answer 1

如果我理解正確，那么以下內容將循環遍歷給定的目錄，它將打開並檢查每個文件以獲取所需信息，如果找到，它會將值添加到您的主工作簿中。

注意：如果文件名中包含“Master”，此代碼將不會打開文件。

Sub LoopThroughFolder()
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim wb As Workbook
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim myFile As File
Dim AccNumber As String
Dim LastRow As Long, i As Long
Dim sPath As String
sPath = "C:\Work\2017"

LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Application.DisplayAlerts = False
'do not display alerts
Set myFolder = FSO.GetFolder(sPath) 'set the root folder
    For Each myFile In myFolder.Files 'for each file in the folder
        If InStr(myFile.Name, "Master") = 0 Then
        'if file to open does not have "Master" in it's name then
            Set wb = Workbooks.Open(myFile.Path) 'open the file
            AccNumber = wb.Sheets(1).Range("B2") 'check for account number on first Sheet
            For i = 1 To LastRow 'loop through current Sheet to check if we have a match for the account number
                If ws.Cells(i, 1) = AccNumber Then 'if match
                ws.Cells(i, 2) = wb.Sheets(1).Range("B9") 'pass the values from the required range
                ws.Cells(i, 3) = wb.Sheets(1).Range("E9")
                End If
            Next i
            wb.Close False 'close and do not save changes
            Set wb = Nothing
        End If
    Next
Application.DisplayAlerts = True
End Sub

此外，您可能必須設置對相關庫的引用才能使用FileSystemObject ，以執行此操作：

如何在 VBA 中使用 FileSystemObject？

在 Excel 中，您需要設置對 VB 腳本運行庫的引用。 相關文件通常位於\\Windows\\System32\\scrrun.dll

• 要引用此文件，請加載 Visual Basic 編輯器 ( ALT + F11 )
• 從下拉菜單中選擇工具 > 參考
• 將顯示可用參考的列表框
• 勾選“ Microsoft Scripting Runtime ”旁邊的復選框
• scrrun.dll文件的全名和路徑將顯示在列表框下方
• 單擊確定按鈕。