防止excel中的重复复制粘贴

时间:2013-04-17 09:10:20

标签: excel vba excel-vba copy-paste validation

嗨,所有的菜鸟又回来了。我正在将数据从一个工作表复制粘贴到另一个工作表中,这是隐藏的,但是如果不对已经粘贴的内容进行检查,则存在重复数据的危险。到目前为止,我所做的是在我要复制的工作表中插入代码,以停止复制,但我现在的复杂性是验证是从头到尾检查整个列中的每一位数据,这是约5000<条目。 B列的报告日期与属于同一月末的所有条目相同。因此,它将说30条带有30/1/13 ....另有28/02/13等等。理想情况下,我想只在B列中检查一次输入报告日期,以及日期是否匹配到什么我想复制,然后拒绝整个复制粘贴过程,而不是验证复制范围中的每个单独条目。这是我正在使用的代码。我希望我能够理解&非常感谢你的帮助。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Dim ans As String
    Const myCol As Long = 2

    If Intersect(Target, Columns(myCol)) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    For Each r In Intersect(Target, Columns(myCol))
        If Application.CountIf(Columns(myCol), r.Value) > 1 Then
            MsgBox (r.Value & " already exsists")
            r.ClearContents
        End If
    Next
    Application.EnableEvents = True
End Sub

这就是我的代码,包括删除重复,但它不起作用。我试过了

Sub LoadData_toTable()
Dim ws1LRow As Long, ws2LRow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Application.ScreenUpdating = False
Set ws1 = ThisWorkbook.Sheets("RAW DATA")
Set ws2 = ThisWorkbook.Sheets("DATA INPUT")
       With ws1
        ws1LRow = .Cells.Find(What:="*", _
                    After:=.Range("A1"), _
                    Lookat:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row + 1

        End With
            With ws2
                    ws2LRow = .Range("G" & .Rows.Count).End(xlUp).Row
                    .Range("A2:AR" & ws2LRow).Copy
                    ws1.Range("A" & ws1LRow).PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                    Application.ScreenUpdating = True
            End With
                With ws1
                ws1.Range("A:A").RemoveDuplicates
            End With
            For Each WS In ThisWorkbook.Worksheets
        For Each PT In WS.PivotTables
            PT.RefreshTable
        Next PT
    Next WS

 MsgBox "Loading month's data complete!"
End Sub

1 个答案:

答案 0 :(得分:0)

一个非常长的计算时间解决方案是创建一个只包含不等于工作表中已有数据的数组(您必须迭代每个复制的元素并与隐藏工作表中的每个元素进行比较)。

否则,您可以以某种方式格式化重复数据,然后迭代并删除除第一个之外的所有格式化数据(您将像以前一样重新格式化)。例如:

Selection.NumberFormat = "0.0 ""double"""  '<--- this could be made also with colors
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
ExecuteExcel4Macro "(2,1,""0.0 ""double"""")"
Selection.FormatConditions(1).StopIfTrue = False

然后在迭代内

cells(x,y).select

if counted_formatted_data = 1 then
    Selection.NumberFormat = "0.0 " '<--- back to the previous formatting
else
    selection.delete
end if

当然,最好不要选择任何东西。