input框取消excel vba

这段代码复制一个excel数据块(Col A到Col BH),并提示用户select复制模板需要粘贴的行。 代码似乎工作得很好(随意清理/优化任何代码),我的问题是每当用户点击取消时,他们需要select行我得到一个错误“运行时错误13types不匹配”。 如果select取消,是否有结束macros?

Sub CopyTemplate() Worksheets("HR-Calc").Activate Dim rng As Variant Dim trng As Range Dim tco As String Dim hi As String Dim de As String 'Use the InputBox select row to insert copied cells Set rng = Application.InputBox("select row to paste into", "Insert template location", Default:=ActiveCell.Address, Type:=8) startrow = rng.Row ' MsgBox "row =" & startrow Range("Bm2") = startrow Application.ScreenUpdating = False 'copy template block Range("C6").End(xlDown).Select Range("bm1") = ActiveCell.Offset(1, 0).Row Worksheets("HR-CAlc").Activate tco = "A6:bh" & Range("bm1") Range(tco).Select Selection.Copy Range("A" & Range("bm2")).Activate Selection.Insert Shift:=xlDown Range("c100000").End(xlUp).Select Selection.End(xlUp).Select 'mycell.Select ''Use the InputBox to select text to be replaced ''Set rep = Application.InputBox("select data range where text will be replaced", Default:=ActiveCell.Address, Type:=8) 'Set rep = ActiveCell ' Told = Application.InputBox("Find the text that needs to be replaced", "Find text in Input data", Default:=ActiveCell.Value, Type:=2) ' If Told = "" Or vbCancel Then ' End If ' ' Tnew = Application.InputBox("Input desired text", "Replace text in data", Default:=ActiveCell.Value, Type:=2) ' If Tnew = "" Or vbCancel Then ' End If ' ' rep.Select ' Selection.Replace What:=Told, Replacement:=Tnew, LookAt:=xlPart, _ ' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ' ReplaceFormat:=False Range("bm1:bm2").ClearContents SendKeys "{F2}" SendKeys "{BS}" Application.ScreenUpdating = True End Sub 

您仍然需要error handling来检测取消

 Dim rng As Range '<~~~ change type so If test will work 'Use the InputBox select row to insert copied cells Set rng = Nothing ' in case it was previously set On Error Resume Next Set rng = Application.InputBox("select row to paste into", "Insert template location", Default:=ActiveCell.Address, Type:=8) On Error GoTo 0 ' or your error handler If rng Is Nothing Then ' User canceled, what now? Exit Sub 'maybe... End If 

添加这些行包括error handling程序

 On Error Resume Next Set rng = Application.InputBox("select row to paste into", "Insert template location", Default:=ActiveCell.Address, Type:=8) On Error GoTo 0 If IsEmpty(rng) = True Then Exit Sub End If 

这些线将退出子,如果它不会find任何价值rng