Question

我在SheetNames内有一个收集字词，我试图为Worksheet中的每个字词添加新的SheetNames，请找到以下代码。

在添加Worksheet之前我尝试使用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的代码告别不一致。

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

我可以看到一些工作表添加了名称＆＃34; Sheet99＆＃34;或＆＃34; Sheet12＆＃34;即使将SheetName传递给函数。有时如果sheetExists function returns True仍在工作簿中尝试添加worksheet

Answer 1

您的wb As Excel.Workbook有参数Function sheetExists，很棒，请使用它！为什么然后使用危险的ActiveWorkbook，它有可能成为其他WB而不是你要检查的那个？

将所有ActiveWorkbook替换为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

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

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

1 个答案: