Excel VBA搜索和粘贴脚本错误

Question

我正在制作excel VBA脚本，该脚本将复制和粘贴第一张工作表上的值(输入)到数据存储表(数据)。如果输入表的J4单元格上的更新标志变为1，则它将搜索包含输入表的K4单元格上的值的DATA表的单元格，并将值粘贴到该单元格上。一半的目标已经完成，但当编写脚本查找并粘贴值到具有K4值的单元格时，它称为

error 1004: Application-defined of object-defined error

在脚本的PasteSpecial行。

我的脚本在这里:

Sub add_data()
Dim DATA As Worksheet
Dim Input As Worksheet
Dim otk As Range
Set D = ThisWorkbook.Sheets("DATA")
Set I = ThisWorkbook.Sheets("Input")
L = 1
While L = 1
If I.Range("J4").Value = 0 Then
I.Range("K4:UX4").copy
lastrow = D.Range("B1")
D.Range("A" & lastrow).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=False
L = 0
Else
With D.Range("A1:A10000")
Set otk = .Find(I.Range("K4").Value, LookIn:=xlValues)
If Not otk Is Nothing Then
I.Range("J4").Value = 0
Else
I.Range("K4:UX4").copy
D.Range(otk).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=False
L = 0
End If
End With
End If
Wend
End Sub

Answer 1

问题就在这里

Set otk = .Find(I.Range("K4").Value, LookIn:=xlValues)
If Not otk Is Nothing Then
' runs when otk is something
I.Range("J4").Value = 0
Else
' runs when otk is nothing
I.Range("K4:UX4").copy
D.Range(otk).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=False
L = 0
End If

否则，当你进入Else部分时，otk是零。此外，otk是一个范围对象而不是地址，所以您需要将其用作otk.PasteSpecial。

所以你需要把If Not otk Is Nothing Then改成If otk Is Nothing Then

Set otk = .Find(I.Range("K4").Value, LookIn:=xlValues)
If otk Is Nothing Then
' runs when otk is nothing
I.Range("J4").Value = 0
Else
' runs when otk is something
I.Range("K4:UX4").copy
otk.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=False
L = 0
End If

或者你可以切换Else和If部分的内容。

Set otk = .Find(I.Range("K4").Value, LookIn:=xlValues)
If Not otk Is Nothing Then
' runs when otk is something
I.Range("K4:UX4").copy
otk.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=False
L = 0
Else
' runs when otk is nothing
I.Range("J4").Value = 0
End If