Excel 主文件即使在执行完成后也会打开

Excel 主文件即使在执行完成后也会打开,excel,vba,Excel,Vba,我有一个vba代码(不是我从另一个站点复制的),它根据特定的列将主文件中的数据分割成多个文件,现在数据分割成多个文件后,代码执行已经完成,但主文件最后打开了,这不是很好,尝试了各种方法来应用代码来保存主文件并关闭主文件,但不起作用,我不知道vba编码,主文件是FE_JUL.xlsx Sub ExportDatabaseToSeparateFiles() 'Export is based on the value in the KeyCol Dim myWb As Workboo

我有一个vba代码(不是我从另一个站点复制的),它根据特定的列将主文件中的数据分割成多个文件,现在数据分割成多个文件后,代码执行已经完成,但主文件最后打开了,这不是很好,尝试了各种方法来应用代码来保存主文件并关闭主文件,但不起作用,我不知道vba编码,主文件是FE_JUL.xlsx

Sub ExportDatabaseToSeparateFiles()
     'Export is based on the value in the KeyCol
    Dim myWb As Workbook
    Dim myCell As Range
    Dim mySht As Worksheet
    Dim myName As String
    Dim myArea As Range
    Dim myShtName As String
    Dim KeyCol As String
    Dim myField As Integer

    Application.ScreenUpdating = False
    Workbooks.Open Filename:="C:\FInal Estimate\Excel\2019\temp\FE_JUL.xlsx"
    Set myWb = Application.Workbooks("FE_JUL.xlsx")
    myWb.Activate
    myShtName = ActiveSheet.Name
    KeyCol = "A"
    Set myArea = Intersect(ActiveSheet.UsedRange, Range(KeyCol & "1").EntireColumn).Cells
    Set myArea = myArea.Offset(1, 0).Resize(myArea.Rows.Count - 1, 1)
    myField = myArea.Column - myArea.CurrentRegion.Cells(1).Column + 1
    For Each myCell In myArea
        On Error GoTo NoSheet
        myName = Worksheets(myCell.Value).Name
        GoTo SheetExists:

NoSheet:
        Set mySht = Worksheets.Add(Before:=Worksheets(1))
        mySht.Name = myCell.Value
        With myCell.CurrentRegion
            .AutoFilter Field:=myField, Criteria1:=myCell.Value
            .SpecialCells(xlCellTypeVisible).Copy _
                    mySht.Range("A1")
            mySht.Cells.EntireColumn.AutoFit
            .AutoFilter
        End With
        Resume

SheetExists:
    Next myCell
    For Each mySht In ActiveWorkbook.Worksheets
        If mySht.Name = myShtName Then
            Exit Sub
        Else
            mySht.Move
            ActiveWorkbook.SaveAs "C:\FInal Estimate\Excel\2019\temp\temp\" & ActiveSheet.Name & ".xlsx"
            ActiveWorkbook.Close
        End If
    Next mySht

    myWb.Save
    myWb.Close

End Sub

代码不起作用的主要原因是存在一个退出子系统的
Exit子系统
,因此
myWb.Close
。您必须将其替换为退出

尽管如此,我还是建议对代码进行如下改进,以使其更加坚实可靠。你可能会从阅读中受益 . 另外,使用
Goto
也是一种不好的做法。请参阅下文,了解没有它的解决方案

Option Explicit

Sub ExportDatabaseToSeparateFiles()
    'Export is based on the value in the KeyCol
    Application.ScreenUpdating = False

    Dim myWb As Workbook
    Set myWb = Workbooks.Open(Filename:="C:\FInal Estimate\Excel\2019\temp\FE_JUL.xlsx")

    Dim MySht As Worksheet
    Set MySht = myWb.ActiveSheet

    Const KeyCol As String = "A"

    Dim myArea As Range
    Set myArea = Intersect(MySht.UsedRange, MySht.Range(KeyCol & "1").EntireColumn).Cells
    Set myArea = myArea.Offset(1, 0).Resize(myArea.Rows.Count - 1, 1)

    Dim myField As Long
    myField = myArea.Column - myArea.CurrentRegion.Cells(1).Column + 1

    Dim myCell As Range
    For Each myCell In myArea
        If Not WorksheetExists(myCell.Value, myWb) Then
            Dim AddedSht As Worksheet
            Set AddedSht = myWb.Worksheets.Add(Before:=myWb.Worksheets(1))
            AddedSht.Name = myCell.Value
            With myCell.CurrentRegion
                .AutoFilter Field:=myField, Criteria1:=myCell.Value
                .SpecialCells(xlCellTypeVisible).Copy AddedSht.Range("A1")
                AddedSht.Cells.EntireColumn.AutoFit
                .AutoFilter
            End With
        End If
    Next myCell

    Dim ws As Worksheet
    For Each ws In myWb.Worksheets
        If ws.Name = MySht.Name Then
            Exit For
        Else
            ws.Move
            ActiveWorkbook.SaveAs "C:\FInal Estimate\Excel\2019\temp\temp\" & ActiveSheet.Name & ".xlsx"
            ActiveWorkbook.Close SaveChanges:=False
        End If
    Next ws

    Application.ScreenUpdating = True

    myWb.Save
    myWb.Close SaveChanges:=False
End Sub


Public Function WorksheetExists(WorksheetName As String, Optional InWorkbook As Workbook) As Boolean
    If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = InWorkbook.Worksheets(WorksheetName)
    On Error GoTo 0

    WorksheetExists = Not ws Is Nothing
End Function

您首先关闭的是
ActiveWorkbook
(因为当您打开工作簿时,它会成为焦点,因此ActiveWorkbook)在本例中是相同的
myWb
,因此不,您不会关闭代码中的任何主工作簿。您应该尽量避免使用
.Activate
,因为这会导致类似的问题。此外,您使用了太多的
GoTo
,因为它可以更容易地处理,也不容易混淆。为主工作簿设置一个变量,并使用该变量关闭主工作簿。感谢Damien的评论,您能帮我解释一下您要解释的代码吗?现在,您的代码将关闭主文件。。。如果是“FE_JUL”,而不是以前的9月。抱歉,由于多个文件,我刚开始融合。我想您的意思是在执行完成后关闭运行代码的工作簿?您好,我复制粘贴了与它相同的代码并执行了它,收到一个错误作为“对象变量或未设置块变量”@Ajay在哪一行?@Ajay如果这回答了您的问题,请向上投票/将其标记为已解决:无论如何,我强烈建议优化代码。当我单击“调试”时,它以黄色显示运行时错误“91”“对象变量或未设置块变量”的第16行“尝试编辑并成功,感谢帮助人员:):)