使用每个循环通过一系列工作簿

时间:2016-05-01 19:30:16

标签: vba excel-vba excel

我是一名VBA新手试图弄清楚如何遍历一系列工作簿及其工作表,以寻找特定的工作表,但我的对象变量遇到了一些问题。

以下是我“编写”的代码(粘合在一起可能是更贴切的描述)。我尝试了各种修正,但似乎只是将问题从一个地方转移到另一个地方。任何帮助将不胜感激!

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

2 个答案:

答案 0 :(得分:2)

为了使您的代码有效,只需要进行一些更改:

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

如果您对更改有任何疑问,请与我们联系。

答案 1 :(得分:0)

就在1周前,我写了一个脚本转到指定的文件夹(用户选择)并列出该文件夹中的所有Excel文件和工作表名称。

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
相关问题