gpt4 book ai didi

excel - 每 15 分钟运行一次宏

转载 作者:行者123 更新时间:2023-12-04 21:28:10 25 4
gpt4 key购买 nike

我需要每 15 分钟刷新一次“数据”表。刷新表后,我需要从 D10、J10 复制数据并粘贴到“图表表”中。但是,首先粘贴时,它应该从 B2 开始,然后下次数据应该粘贴到 B2 下方,即 C2 以此类推。
下面是代码

Option Explicit

Sub Refresh()
Sheets("Data").Select

ActiveWorkbook.RefreshAll
Sheets("Collection").Select

Range("D10,J10").Select
Selection.Copy

Sheets("Chart").Select

'But while pasting first it should start from B2 & then
'next time data should paste below B2 i.e C2 so on & so forth
Range("B2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Application.OnTime TimeValue("09.00.00"), "Refresh"
End Sub

最佳答案

有两种方法可以解决这个问题。事实上,这个答案将涵盖这两个方面的细节,所以请耐心等待我。我将详细回答这个答案,因为我相信这肯定会对 future 的访客有所帮助。

方式 01:VB 脚本 + Windows 任务计划程序

设置 VB 脚本

  • 打开记事本
  • 粘贴此代码

  • 代码:
    Dim ExcelApp, ExcelWB
    Set ExcelApp = CreateObject("Excel.Application")

    '~~> Change this to the relevant Excel File
    Set ExcelWB = ExcelApp.Workbooks.Open("C:\Users\routs\Desktop\Sample.xlsm")

    ExcelApp.Run "Refresh"

    ExcelWB.Close True

    ExcelApp.Quit
    Set ExcelApp = Nothing
  • 将文件另存为 MyTask.Vbs

  • enter image description here
    设置任务调度程序(Win 10)
    在 Windows 中启动任务计划程序。如果您不知道如何操作,请输入 Task Scheduler在 Windows 搜索中。
    enter image description here
    点击 Create TaskActions 下然后在 General中填写基本信息标签
    enter image description here
    Trigger 中设置相关设置标签
    enter image description here
    下一个 Action选项卡,创建新操作并选择相关详细信息
    enter image description here
    同样检查其他选项卡,看看是否需要设置其他任何内容
    设置 Excel 宏
    将此代码粘贴到模块中
    Option Explicit

    Sub Refresh()
    Dim wsCopyFrom As Worksheet
    Dim wsCopyTo As Worksheet
    Dim lastCol As Long

    ThisWorkbook.RefreshAll

    Set wsCopyFrom = ThisWorkbook.Sheets("Collection")
    Set wsCopyTo = ThisWorkbook.Sheets("Chart")

    '~~> Find the next empty column where data will be pasted
    lastCol = wsCopyTo.Cells(1, wsCopyTo.Columns.Count).End(xlToLeft).Column + 1

    wsCopyFrom.Range("D10,J10").Copy
    DoEvents

    wsCopyTo.Cells(2, lastCol).PasteSpecial _
    Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    DoEvents
    End Sub
    我们完成了。

    方式 02:从 EXCEL 处理一切

    将此代码粘贴到 Excel 中的模块中 ( 未经测试 )
    Sub Refresh()
    Dim wsCopyFrom As Worksheet
    Dim wsCopyTo As Worksheet
    Dim lastCol As Long

    ThisWorkbook.RefreshAll

    Set wsCopyFrom = ThisWorkbook.Sheets("Collection")
    Set wsCopyTo = ThisWorkbook.Sheets("Chart")

    '~~> Find the next empty column where data will be pasted
    lastCol = wsCopyTo.Cells(1, wsCopyTo.Columns.Count).End(xlToLeft).Column + 1

    wsCopyFrom.Range("D10,J10").Copy
    DoEvents

    wsCopyTo.Cells(2, lastCol).PasteSpecial _
    Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    DoEvents

    '~~> Do not do anything after 5 PM
    If Now < Date + TimeValue("17:00:00") Then
    Application.OnTime Now + TimeValue("00:15:00"), "Refresh"
    End If
    End Sub
    早上 9 点只运行一次程序。
    有趣的阅​​读: How to avoid using Select in Excel VBA

    关于excel - 每 15 分钟运行一次宏,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/64963430/

    25 4 0
    Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
    广告合作:1813099741@qq.com 6ren.com