拷贝内容到表2如遇重复项则不执行

zhangv712

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

   If Target.Column = 4 Then
   arr = Range("a2:c" & Range("a65536").End(3).Row)
        'Range("a2:c4").ClearContents
        With Sheets("12")
            .Range("a" & .Range("a65536").End(3).Row + 1).Resize(UBound(arr), UBound(arr, 2)) = arr
        End With
        End If
End Sub



这个是目前的代码  烦请老师指点！！

爱疯

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 4 And pd Then test
End Sub


'判断
Function pd() As Boolean
    Dim A, x, y
    A = Sheets(1).Range("a2").CurrentRegion
    x = Arr2Str(A)
    A = Sheets(2).Range("a2").CurrentRegion
    y = Arr2Str(A)
    pd = InStr(y, x) = 0
End Function


'数组转字符串
Function Arr2Str(A) As String
    Dim i, j
    For i = 1 To UBound(A)
        For j = 1 To UBound(A, 2)
            Arr2Str = Arr2Str & A(i, j) & ","
        Next j
    Next i
End Function


'操作
Sub test()
    arr = Range("a2:c" & Range("a65536").End(3).Row)
    'Range("a2:c4").ClearContents
    With Sheets("12")
        .Range("a" & .Range("a65536").End(3).Row + 1).Resize(UBound(arr), UBound(arr, 2)) = arr
    End With
End Sub

zhangv712

感谢版主 ！！！实在太完美了  {:3_52:}