避免添加重复的工作表到Excel工作簿

我在SheetNames里面有一个集合的单词，我试图为SheetNames每个单词添加新的Worksheet ，请find下面的代码。

在添加Worksheet之前，我尝试使用sheetExists functionvalidation工作簿中是否已经存在工作sheetExists function ，下面提供了代码。

 For Each SheetName In SheetNames If sheetExists(SheetName , newWB) = False Then newWB.Activate Set FilPage = Worksheets.Add FilPage.Activate SheetName = Replace(Replace(Replace(Replace(Replace(SheetName, ".", " "), "[", " "), "]", " "), "/", "_"), "\", " ") If Len(SheetName) <= 30 Then FilPage.Name = SheetName Else SheetName = Left(SheetName, 23) & "-trimed" End If ActiveSheet.Range("A1").Activate ActiveCell.PasteSpecial End If Next 

使用function sheetExists代码valediction function sheetExists工作。

 Function sheetExists(sheetToFind ,wb As Excel.Workbook) As Boolean WS_Count = ActiveWorkbook.Worksheets.Count sheetExists = False For I = 1 To WS_Count If ActiveWorkbook.Worksheets(I).Name = sheetToFind Then sheetExists = True Exit Function End If Next End Function 

即使将SheetName传递给函数，我也可以看到一些名称为“Sheet99”或“Sheet12”的工作表。 有时如果sheetExists function returns True仍然工作簿正在尝试添加worksheet

Answer 1

你有一个参数wb As Excel.Workbook你的Function sheetExists ，很好，使用它！ 那么为什么要使用危险的ActiveWorkbook ，它有一切机会成为你想要检查的其他WB？

将所有出现的ActiveWorkbookreplace为wb

 Function sheetExists(sheetToFind ,wb As Excel.Workbook) As Boolean WS_Count = wb.Worksheets.Count ' <-------------------------------------- wb sheetExists = False For I = 1 To WS_Count If wb.Worksheets(I).Name = sheetToFind Then ' <------------------- wb sheetExists = True Exit Function End If Next End Function 

而且，除了删除Activate之外，其他代码还需要一些更正

 For Each SheetName In SheetNames If Not sheetExists(SheetName , newWB) Then Set FilPage = newWB.Worksheets.Add SheetName = Replace(Replace(Replace(Replace(Replace(SheetName, ".", " "), "[", " "), "]", " "), "/", "_"), "\", " ") If Len(SheetName) > 30 Then SheetName = Left(SheetName, 23) & "-trimed" FilPage.Name = SheetName FilPage.Range("A1").PasteSpecial End If Next 

---

SheetExists函数可以进一步简化为：（版权所有@DavidZemens）

 Function sheetExists(sheetToFind,wb As Excel.Workbook) As Boolean Dim ws as Worksheet sheetExists = False On Error Resume Next Set ws = wb.Worksheets(sheetToFind) sheetExists = Not (ws Is Nothing) End Function