时间戳

首页 > 解决方案 > Excel VBA 定时器后删除

excel - Excel VBA 定时器后删除

问题描述

我想复制并粘贴一堆信息sheet A，sheet B我想sheet B在某个时间范围后删除这些信息。但是，宏应该能够多次运行，并且后续信息sheet A应该粘贴在sheet B尚未删除的当前粘贴信息下方。我当前的代码可以做到这一点，但我有一个问题，如果我sheet B第二次粘贴更多信息，删除功能会搞砸。

复制粘贴功能：

Sub Cache()

Dim NoOfCrew As Long

NoOfCrew = Sheets("Cache").Cells(Rows.Count, "A").End(xlUp).Row
NoOfCrew = NoOfCrew + 1

Sheets("Hotel Booking").Range("Q10:U19").Copy
Sheets("Cache").Range("A" & NoOfCrew).PasteSpecial

Sheets("Hotel Booking").Range("X10:X19").Copy
Sheets("Cache").Range("F" & NoOfCrew).PasteSpecial

Application.CutCopyMode = False
Run "DelayMacro"
End Sub

删除功能：

Sub Delete()

Dim NoOfCrew As Long

NoOfCrew = Sheets("Hotel Booking").Cells(Rows.Count, "Q").End(xlUp).Row
NoOfCrew = NoOfCrew - 8

Sheets("Cache").Range("A2:F" & NoOfCrew).Delete shift:=xlUp

End Sub

延迟功能：

Sub DelayMacro()

Application.OnTime Now() + TimeValue("00:00:10"), "Delete"

End Sub

还问了这个：

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1205362-excel-vba-delete-after-timer

http://www.vbaexpress.com/forum/showthread.php?63161-Excel-VBA-Delete-after-timer&p=381929#post381929

标签： excelvbaexcel-2016

解决方案

您需要跟踪每次复制的数量或行数，也许还有起始行……但是当我键入此内容时，我意识到起始行不是必需的，只会使事情复杂化。无论如何，我已经用起始行修复了它，所以它是......

Type CacheArea
    StartingRow As Long
    Rows As Long
End Type

Private PasteCache() As CacheArea, CacheCount As Long

Sub Cache()
Dim NoOfCrew As Long

    NoOfCrew = Sheets("Cache").Cells(Rows.Count, "A").End(xlUp).Row
    NoOfCrew = NoOfCrew + 1

    Sheets("Hotel Booking").Range("Q10:U19").Copy
    Sheets("Cache").Range("A" & NoOfCrew).PasteSpecial

    Sheets("Hotel Booking").Range("X10:X19").Copy
    Sheets("Cache").Range("F" & NoOfCrew).PasteSpecial

    ReDim Preserve PasteCache(CacheCount)
    With PasteCache(CacheCount)
        .StartingRow = NoOfCrew
        .Rows = Sheets("Hotel Booking").Range("X10:X19").Rows.Count
    End With
    CacheCount = CacheCount + 1

    Application.CutCopyMode = False
    Run "DelayMacro"
End Sub


Sub Delete()
Dim NoOfCrew As Long, Row As Long

    If CacheCount > 0 Then
        Row = PasteCache(0).StartingRow
        NoOfCrew = PasteCache(0).Rows
        Sheets("Cache").Range("A" & Row & ":F" & Row + NoOfCrew - 1).Delete shift:=xlUp
    End If

    ' Shift all the values up in the buffer 
    ' Not required if we don't use .StartingRow and just assume that you are deleting from the top
    For i = 1 To CacheCount - 1
        PasteCache(i - 1) = PasteCache(i)
        ' Adjust all the starting rows down by the number of rows deleted.
        PasteCache(i - 1).StartingRow = PasteCache(i - 1).StartingRow - Rows
    Next

    ' Remove the extra entry
    If CacheCount > 0 Then
        ReDim Preserve PasteCache(CacheCount - 1)
        CacheCount = CacheCount - 1
    End If
End Sub

推荐阅读