Excel / VBA - 工作表更改事件复制/粘贴/清除数据

时间:2015-12-09 01:50:13

标签: excel-vba vba excel

我是VBA的新手,我正在尝试使用excel自动执行日常工作。基本上我只想从我们拥有的工具中复制原始数据,然后将其粘贴到excel。宏所做的是处理数据,将其放在表格中并生成摘要,然后将其用于我们的报告。为此,我有以下代码

Private Sub Worksheet_Change(ByVal Target As Range)
Dim processDB As Integer
Dim xWs As Worksheet
Dim xTable As PivotTable
If Not Application.Intersect(Range("A:D"), Target) Is Nothing Then
    processDB = MsgBox("Raw data has been changed. Do you want to accept the changes?", vbOKCancel)
    Application.EnableEvents = False
    If processDB = 2 Then
        Application.Undo
    End If
    Application.EnableEvents = True
    For Each xWs In Application.ActiveWorkbook.Worksheets
        For Each xTable In xWs.PivotTables
            xTable.RefreshTable
        Next
    Next
ndata = Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheet3.Range("A" & ndata & ":" & "D" & ndata).Value = Sheet2.Range("B6:E6").Value
End If
End Sub

问题是旧数据大于新数据。让我们说old = A1:D10然后new = A1:D5所以应该清除A6:D10。在处理之前,我需要以某种方式清除新粘贴的表下面的值。我正在考虑使用全局变量来记录行的最后一个值,然后使用它,但我不确定是否有另一种方法可以做到这一点。

我从另一个应用程序复制原始数据,然后将其粘贴到sheet1 ...当代码检测到更改时,它只更新工作表2上的数据透视表,并将在工作表3上记录当天的摘要。我遇到的问题是当我粘贴较小的数据范围时。

OLD
AAA BBB CCC DDD
11  12  13  14
12  13  14  15

NEW
AAA BBB CCC DDD
33  36  39  44

Result
AAA BBB CCC DDD
33  36  39  44
12  13  14  15 <<< need this cleared somehow when I paste the new data

对于新手问题,我们非常感谢和抱歉:(

1 个答案:

答案 0 :(得分:0)

您可以使用Target事件的Worksheet_Change参数来确定粘贴了多少行,并将其与仍然存在的任何其他行进行比较,并删除其中的任何其他行。

我已经在下面的代码中充实了它并进行了测试。我还根据你的问题以某种方式重构了你的代码。我还在代码中添加了大量注释来解释自己。如果我踩到你的代码太多,请忽略我可能误解和道歉的任何事情:)

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Range("A:D"), Target) Is Nothing Then

    'confirm changes
    Dim processDB As Integer

    processDB = MsgBox("Raw data has been changed. Do you want to accept the changes?", vbOKCancel)

    If processDB = 2 Then

        With Application
            .EnableEvents = False
            .Undo
            .EnableEvents = True
        End With

        Exit Sub 'put this because do you really need to update pivot tables and other data if there is no change?

    End If

    'clear out old data
    Dim lRowsRange As Long, lRowsTotal As Long
    lRows = Target.Rows.Count 'get row count of newly pasted range
    lRowsTotal = Me.Range("A" & Me.Rows.Count).End(xlUp).Row 'get row count of all data on sheet

    If lRowsTotal > lRows Then

        Application.EnableEvents = False
        Me.Range(Rows(lRowsTotal), Rows(lRows + 1)).Delete 'if total rows of data is more than paste range, delete extra rows
        Application.EnableEvents = True

    End If

    'refresh pivot tables
    ThisWorkbook.RefreshAll

    'Dim xWs As Worksheet, xTable As PivotTable
    'For Each xWs In ThisWorkbook.Worksheets
    '    For Each xTable In xWs.PivotTables
    '        xTable.RefreshTable
    '    Next
    'Next

    ndata = Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Sheet3.Range("A" & ndata & ":" & "D" & ndata).Value = Sheet2.Range("B6:E6").Value

End If

End Sub