Question

EXCEL高手请进，求完善一下VBA代码~

Private Sub Worksheet_Change(ByVal Target As Range)
cc = Target.Column
rr = Target.Row
If cc = 2 Or cc = 3 Then
If d Is Nothing Then
Call test
End If
If Cells(rr, 2) < Cells(rr, 3) Then
xm = Cells(rr, 2) & "," & Cells(rr, 3)
Else
xm = Cells(rr, 3) & "," & Cells(rr, 2)
End If
If d.Exists(xm) Then
Cells(rr, 4) = d(xm)
Else
Cells(rr, 4) = ""
End If
End If
End Sub
代码如上，求完善代码，使之复制和黏贴也能触发代码执行

Answer 1

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cc, rr As Integer
cc = Target.Column

rr = Target.Row

If cc = 2 Or cc = 3 Then

If d Is Nothing Then 'd是什么？
Call test 'test 是什么？
End If

If Cells(rr, 2).Value < Cells(rr, 3).Value Then
xm = Cells(rr, 2) & "," & Cells(rr, 3) 'xm是什么？
Else
xm = Cells(rr, 3) & "," & Cells(rr, 2)
End If

If d.Exists(xm) Then
Cells(rr, 4).Value = d(xm)
Else
Cells(rr, 4).Value = ""
End If

End If
End Sub
我只帮你修改了一部分，你要写这段代买实现什么目标你应该说出来，这样的话才能更好的帮你改，只有代码看起来很烦的

Answer 2

单纯的 复制触发事件是没的，
复制的时候需要 右键， 加一个右键触发的事件
用CTRL+C 是不会触发的呦

2段代码同时用就能达到目的

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
cc = Target.Column
rr = Target.Row
If cc = 2 Or cc = 3 Then
If d Is Nothing Then
Call test
End If
If Cells(rr, 2) < Cells(rr, 3) Then
xm = Cells(rr, 2) & "," & Cells(rr, 3)
Else
xm = Cells(rr, 3) & "," & Cells(rr, 2)
End If
If d.Exists(xm) Then
Cells(rr, 4) = d(xm)
Else
Cells(rr, 4) = ""
End If
End If
End Sub