Verwenden von für jede durch eine Reihe von Arbeitsmappen durchlaufen

Question

Ich bin ein VBA-Neuling versucht herauszufinden, wie eine Reihe von Arbeitsmappen und ihre Blätter durchlaufen, um ein bestimmtes Blatt zu finden, aber einige Probleme mit meinen Objektvariablen haben .

Unten ist der Code, den ich "geschrieben" habe (zusammengeklebt könnte eine passendere Beschreibung sein). Ich habe verschiedene Korrekturen ausprobiert, aber nur scheinbar das Problem von einem Ort zum anderen verschieben. Jede Hilfe wird geschätzt!

Sub NestedForEach() 
'Create an object variable to represent each worksheet 
Dim WS As Worksheet 
Dim WB As Workbook 
Set WB = ActiveWorkbook 
Set WS = Workbook.Sheets 
'create a boolen variable to hold the status of whether we found worksheet "D" 
Dim IsFound As Boolean 
'initialise the IsFound boolean variable 
IsFound = False 

    For Each WB In Application.Workbooks 
     For Each WS In WB.Worksheets 
      If WS.Name = "d" Then 
       IsFound = True 
       Exit For 
      End If 
     Next WS 
    Next WB 

    If IsFound Then 
     MsgBox "sheet D has been found in " & ActiveWorkbook.Name 
    Else 
     MsgBox "we could not locate sheet D in any of the open workbooks" 
    End If 


End Sub 

Answer 1

Nur wenige Änderungen waren notwendig, um Ihren Code Arbeit zu machen:

Option Explicit 

Sub NestedForEach() 
'Create a Worksheet variable to represent one worksheet 
Dim WS As Worksheet 
Dim WB As Workbook 

'create a boolen variable to hold the status of whether we found worksheet "D" 
Dim IsFound As Boolean 
'initialise the IsFound boolean variable 
IsFound = False 

    For Each WB In Application.Workbooks 
     For Each WS In WB.Worksheets 
      If WS.Name = "d" Then 
       IsFound = True 
       MsgBox "sheet D has been found in " & WB.Name 
       Exit Sub 
      End If 
     Next WS 
    Next WB 

    MsgBox "we could not locate sheet D in any of the open workbooks" & _ 
     Chr(10) & "which are open in this instance of Excel" & _ 
     Chr(10) & "(in case multiple Excels are running)" 

End Sub 

Lassen Sie mich wissen, wenn Sie die Änderungen in Bezug auf alle Fragen haben.

Answer 2

Vor nur 1 Woche schrieb ich ein Skript, um zu einem bestimmten Ordner zu gehen (der Benutzer wählt) und alle Excel-Dateien und Blattnamen in diesem Ordner aufzulisten.

Public Sub LoopAllExcelFilesInFolder() 

Dim WB As Workbook 
Dim myPath As String 
Dim myFile As String 
Dim myExtension As String 
Dim FldrPicker As FileDialog 
Dim sht As Worksheet 
Dim LastRow As Long 

Application.DisplayAlerts = False 

Sheets("ListFilesInFolder").Select 
Set sht = ThisWorkbook.Worksheets("ListFilesInFolder") 
sht.Activate 
Rows("2:2").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.ClearContents 
Range("A1").Select 


    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) 

    With FldrPicker 
     .Title = "Select A Target Folder" 
     .AllowMultiSelect = False 
     If .Show <> -1 Then GoTo NextCode 
     myPath = .SelectedItems(1) & "\" 
    End With 

'In Case of Cancel 
NextCode: 
    myPath = myPath 
    If myPath = "" Then GoTo ResetSettings 

'Target File Extension (must include wildcard "*") 
myExtension = "*.xl*" 

'Target Path with Ending Extention 
myFile = Dir(myPath & myExtension) 

    Do While myFile <> "" 

     Set WB = Workbooks.Open(Filename:=myPath & myFile) 

     With Application 
      .AskToUpdateLinks = False 
     End With 

     For Each Sheet In Workbooks(myFile).Worksheets 
     LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1 
      Workbooks("Questionaire-Mock-Up.xlsb").Worksheets("ListFilesInFolder").Cells(LastRow, 1).Value = myPath & myFile 
      Workbooks("Questionaire-Mock-Up.xlsb").Worksheets("ListFilesInFolder").Cells(LastRow, 2).Value = myFile 
      Workbooks("Questionaire-Mock-Up.xlsb").Worksheets("ListFilesInFolder").Cells(LastRow, 3).Value = Sheet.Name 
       File = InStr(myFile, ".xl") - 1 
       LeftName = Left(myFile, File) 
      Workbooks("Questionaire-Mock-Up.xlsb").Worksheets("ListFilesInFolder").Cells(LastRow, 4).Value = LeftName 
      LastRow = LastRow + 1 
     Next Sheet 

     Workbooks(myFile).Close SaveChanges:=False 
     myFile = Dir 
    Loop 

ResetSettings: 

Application.DisplayAlerts = True 

End Sub