显示Msgbox如果为false,则退出sub

我有macros可以让我select我想要的数据文件,然后继续执行以下步骤。 但是如果我改变了主意并在中途取消(在select文件之前),那么会popup一个消息框,提示“您已经取消了该进程”并退出该子文件夹。

问题是我的macros立即退出子,即使我按下input数据。 我的macros有什么问题导致他们这样做?

Sub trial2() Dim wb As Workbook, wb2 As Workbook, wb3 As Workbook Dim ws As Worksheet Dim fn As String Set wb = ActiveWorkbook 'this is for the excel to add one more worksheet for the raw data Set ws = Sheets.Add(After:=Sheets(Worksheets.Count)) Dim ret As Variant 'this whole part is for importing the raw data files into excel ret = Application.GetOpenFilename("Lkl Files (*.lkl), *.lkl") If ret <> False Then Else MsgBox "You've canceled the process" With ActiveWorkbook .Worksheets(.Worksheets.Count).Delete End With Exit Sub With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & ret, Destination:=Range("$A$1")) .Name = ret .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 65001 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileDecimalSeparator = "," .TextFileThousandsSeparator = "." .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End If Sheets(2).Activate 'this is to search for the next empty cell and put the date Dim FirstCell As String Dim i As Integer FirstCell = "C19" Range(FirstCell).Select Do Until ActiveCell.Value = "" If ActiveCell.Value = "" Then Exit Do Else ActiveCell.Offset(1, 0).Select End If Loop ActiveCell = datepart(ret) 'this is to filter the raw data into the desired value ws.Activate ws.AutoFilterMode = False 'change the value of Criteria1 between "" into the desired value for filtering ws.Range("$A$9:$P$417").AutoFilter Field:=5, Criteria1:= _ "1" Range("F31:F401").Select Selection.Copy Sheets(2).Activate 'this is for the raw data to be copied into each worksheet FirstCell = "D19" Range(FirstCell).Select Do Until ActiveCell.Value = "" If ActiveCell.Value = "" Then Exit Do Else ActiveCell.Offset(1, 0).Select End If Loop Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Sheets(3).Activate FirstCell = "C19" Range(FirstCell).Select Do Until ActiveCell.Value = "" If ActiveCell.Value = "" Then Exit Do Else ActiveCell.Offset(1, 0).Select End If Loop ActiveCell = datepart(ret) ws.Activate Range("D31:D401").Select Application.CutCopyMode = False Selection.Copy Sheets(3).Activate FirstCell = "D19" Range(FirstCell).Select Do Until ActiveCell.Value = "" If ActiveCell.Value = "" Then Exit Do Else ActiveCell.Offset(1, 0).Select End If Loop Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Sheets(4).Activate FirstCell = "C19" Range(FirstCell).Select Do Until ActiveCell.Value = "" If ActiveCell.Value = "" Then Exit Do Else ActiveCell.Offset(1, 0).Select End If Loop ActiveCell = datepart(ret) ws.Activate Range("G31:G401").Select Application.CutCopyMode = False Selection.Copy Sheets(4).Activate FirstCell = "D19" Range(FirstCell).Select Do Until ActiveCell.Value = "" If ActiveCell.Value = "" Then Exit Do Else ActiveCell.Offset(1, 0).Select End If Loop Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True With ActiveWorkbook .Worksheets(.Worksheets.Count).Delete End With End Sub Function datepart(filename As Variant) As Date Dim i As Long Dim s As String For i = 1 To Len(filename) If Mid(filename, i, 8) Like "########" Then s = Mid(filename, i, 8) datepart = DateSerial(Right(s, 4), Mid(s, 3, 2), Left(s, 2)) Exit For End If Next End Function 

你需要移动“End if”后面的那个“Block”,在这个“Exit Sub”之后

 Dim ret As Variant 'this whole part is for importing the raw data files into excel ret = Application.GetOpenFilename("Lkl Files (*.lkl), *.lkl") If ret <> False Then Else MsgBox "You've canceled the process" With ActiveWorkbook .Worksheets(.Worksheets.Count).Delete End With Exit Sub '********** 'Add this here '********** End if With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & ret, Destination:=Range("$A$1")) .Name = ret .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 65001 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileDecimalSeparator = "," .TextFileThousandsSeparator = "." .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With '********** 'Remove this one '********** 'End If 

遗漏结束如果在此之后:

 If ret <> False Then Else MsgBox "You've canceled the process" With ActiveWorkbook .Worksheets(.Worksheets.Count).Delete End With Exit Sub