如果工作表不存在或空白,请转至for循环的下一个迭代

以下是将多个工作簿的特定工作表“按位置修复汇总”中的数据编译到macros工作表“修复汇总”中的代码。

有“按位置修复摘要”没有任何数据的工作簿。 macros应该什么也不做,只能跳到下一个工作簿。

另外,如果表单存在,但是它是空的,那么macros也应该和上面一样。 下面是代码。

'set up the output workbook Set OutBook = ThisWorkbook 'Worksheets.Add Set OutSheet = OutBook.Sheets.Add OutSheet.Name = "Repair Summary" Set OutSheet = OutBook.Sheets(1) 'loop through all files For FileIdx = 1 To TargetFiles.SelectedItems.Count 'open the file and assign the workbook & worksheet Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx)) Set DataSheet = DataBook.Sheets("Repair Summary by Location") 'identify row/column boundaries LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row LastDataCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'if this is the first go-round, include the header If FileIdx = 1 Then Set DataRng = Range(DataSheet.Cells(HeaderRow, 1), DataSheet.Cells(LastDataRow, LastDataCol)) Set OutRng = Range(OutSheet.Cells(HeaderRow, 1), OutSheet.Cells(LastDataRow, LastDataCol)) 'if this is NOT the first go-round, then skip the header Else Set DataRng = Range(DataSheet.Cells(HeaderRow, 1), DataSheet.Cells(LastDataRow, LastDataCol)) Set OutRng = Range(OutSheet.Cells(LastOutRow + 2, 1), OutSheet.Cells(LastOutRow + 2 + LastDataRow, LastDataCol)) End If 'copy the data to the outbook DataRng.Copy OutRng 'close the data book without saving DataBook.Close False 'update the last outbook row LastOutRow = OutSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Next FileIdx 

这是@ Tim解决scheme的替代scheme:

 Public Function getSheet(ByVal wsName As String, Optional wb As Workbook = Nothing) As Worksheet Dim ws As Worksheet If Len(wsName) > 0 Then If wb Is Nothing Then Set wb = ActiveWorkbook For Each ws In wb.Worksheets If ws.Name = wsName Then Set getSheet = ws Exit Function End If Next End If End Function 

并检查该表是否存在并且不是空的:

 Dim ws As Worksheet Set ws = getSheet("Repair Summary by Location") If Not ws Is Nothing Then 'validates if Worksheet exists If WorksheetFunction.CountA(ws) > 0 Then 'validates if Worksheet is not empty ... 

请参阅上述链接中的@ rory的答案。 将它与Application.WorksheetFunction.CountA()一起使用,并将它们合并在一起…只需4行代码…

继续我的评论,这是4行代码

 If Evaluate("ISREF('" & sName & "'!A1)") Then '<~~ If sheet exists If Application.WorksheetFunction.CountA(Sheets(sName).Cells) > 0 Then '<~~ If not empty ' '~~> Your code ' End If End If 

你可以在错误恢复下一步,但我会build议反对一揽子解决scheme。 一旦打开这本书,我将使用一个循环来查找使用函数的工作表。 像这样的东西:

 Function FoundSheet(MySheetName as string) As Boolean Dim WS as Worksheet FoundSheet = False For each WS in worksheets If WS.Name = MySheetName then FoundSheet = True Exit for End if Next End Function 

这个函数返回一个true或false(作为布尔),你可以在你的代码中使用这个:

 If FoundSheet("YourSheetName") then 'Don't need = True or = False on the test as it is a boolean 'Your code goes here Start with a test, select it then see if there is data End if 

我自由地input代码,所以可能有一个错字或两个,但我相信你可以debugging它。

这是一个非常简单的例子,它是如何工作的(我在Sheet1和Sheet2中运行这个工作簿,但没有Sheet3):

 Sub testFunc() Dim X As Long For X = 1 To 3 MsgBox "Sheet" & X & " exists: " & FoundSheet("Sheet" & X) Next End Sub