Question

我有一些宏可以让我先选择我想要的数据文件，然后继续执行以下步骤。但如果我改变主意并在中途取消它（在选择文件之前），则会弹出一个消息框，指出“你已取消该过程”并退出该子程序。

问题是即使我按下输入数据，我的宏也会立即退出sub。我的宏有什么问题导致他们这样做？

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

Answer 1

在此之后缺少结束：

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

Answer 2

你需要将长期使用Block之后的“End if”移动到“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

如果为false则显示Msgbox然后退出子

2 个答案: