Question

此代码复制一个excel数据块（Col A到Col BH），并提示用户选择需要粘贴复制模板的行。代码似乎工作得很好（随意清理/优化任何代码），我的问题是当用户需要选择行时单击取消我得到错误“运行时错误13类型不匹配”。如果选择取消，是否只是结束宏？

 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

Answer 1

您仍然需要错误处理来检测取消

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

Answer 2

添加这些行，包括错误处理程序：

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

如果 rng 找不到任何值，这些行将退出该子行。

输入框取消excel vba

2 个答案: