使用VBA將多個工作簿中的數據合並到母版中時，如何忽略特定文件？

Question

我有一個包含主跟蹤器和多個工作簿的文件夾。 如預期的那樣，下面的代碼將工作簿數據編譯為主文件。

但是，我想在該文件夾中包含一個或兩個wb，此代碼將排除/不打開，而不必在代碼中包含每個wb的標題（因此我可以根據需要添加其他wb，而不必更新腳本）。

我嘗試過添加如下所示的跳過，但是我似乎無法在代碼中正確地找到它，因為我想要的數據的文件路徑和名稱是故意設計成不需要標題的。

FName As String

If FName = "Workbook(s) I want omitted" Then GoTo Skip

Skip:
    'Find the next file
    FName = Dir
  Loop
  'Done

         Sub MASTERPULL()
    Dim wb As String, i As Long, sh As Worksheet
    Application.ScreenUpdating = False
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    Dim sourceSheet As Worksheet
    Set sourceSheet = ActiveSheet
        '<----omitted some formatting code
    wb = Dir(ThisWorkbook.Path & "\*")
    Do Until wb = ""
        If wb <> ThisWorkbook.Name Then
            Workbooks.Open ThisWorkbook.Path & "\" & wb
                For Each sh In Workbooks(wb).Worksheets
                        sh.UsedRange.Offset(1).Copy    '<---- Assumes 1 header row
                            ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                Next sh
            Workbooks(wb).Close False
        End If
        wb = Dir
         Call sourceSheet.Activate
         Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
        End Sub

Answer 1

假設ThisWorkbook是代碼所在的地方，添加一個工作表（如果其他人會看該工作簿並且您不希望他們弄亂列表，則可能是隱藏的），其中包含要跳過的文件列表。 引用該工作表以填充未打開的文件列表。

請注意，這是一些“空中代碼”-可以編譯，但不能保證它是100％完美的。

• 我創建了一個新的工作表，並將其Right-Click | Rename （通過Project Explorer Right-Click | Rename ）為SkipList 。

• 我還添加了對Microsoft Scripting Runtime的引用（“ Tools | References向下滾動直到找到該文本”）。

Option Explicit

Sub MASTERPULL()
  Dim wb As String, i As Long, sh As Worksheet

  Application.ScreenUpdating = False
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False

  Dim sourceSheet As Worksheet
  Set sourceSheet = ActiveSheet
        '<----omitted some formatting code

  '----------------Change here ----------------------------
  Dim skipList As Scripting.Dictionary
  Set skipList = GetFilesToIgnore

  wb = Dir(ThisWorkbook.Path & "\*")
  Do Until wb = ""
    '----------------Change here ----------------------------
    If Not skipList.Exists(wb) Then
      Workbooks.Open ThisWorkbook.Path & "\" & wb
      For Each sh In Workbooks(wb).Worksheets
        sh.UsedRange.Offset(1).Copy              '<---- Assumes 1 header row
        ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
      Next sh
      Workbooks(wb).Close False
    End If
    wb = Dir
    Call sourceSheet.Activate
  Loop

  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Application.AskToUpdateLinks = True

End Sub

'--------------New Function added here
Private Function GetFilesToIgnore() As Scripting.Dictionary

  Dim theList As Scripting.Dictionary
  theList.Add ThisWorkbook.Name, 1

  Dim usedCell As Range
  For Each usedCell In skipList.UsedRange
    theList.Add usedCell.Value, 1
  Next

  Set GetFilesToIgnore = theList

End Function

該代碼假定SkipList工作表中存在一個連續的單元格列表，其中包含要忽略的文件名。 它首先將ThisWorkbook.Name添加到字典中，然后將列表中的其余名稱添加到字典中。

現在，不只是跳過ThisWorkbook.Name ，而是跳過名稱是否存在於字典中的情況。 除了具有易於編輯的其他文件列表要忽略之外，這還增加了即使其名稱已更改也自動跳過ThisWorkbook的好處。

請注意， Dictionary通常是Key/Value對-使用它可以通過其Key快速檢索Value 。 在這種情況下，我們真的不在乎Value ，而只是在使用它，因為在Dictionary查找Key非常快。 因此，我將硬編碼1用作與所有Key綁定的值。 這是一個扔掉的數字，可以更改為Doesn't matter或其他任何讓您滿意的數字。

另外，使用SkipList.UsedRange是一種快速解決問題的方法。 如果您從列表中刪除一個名稱， .UsedRange將返回空白單元格，因此從長遠來看，它可能不是最好的。