money 發問時間: 電腦與網際網路程式設計 · 1 0 年前

Excel VBA 自動複製資料 (15點)

請問各位網友:

如何在Excel中,時間到時自動將某一區塊的資料,每隔一分鐘copy and paste到另一區塊?

例如:

早上8:00時,自動將A1:D10區塊內的資料copy and paste至H1:K10,

早上8:01時,自動將A1:D10區塊內的資料copy and paste至H11:K20,

早上8:02時,自動將A1:D10區塊內的資料copy and paste至H21:K30,

依此類推,每隔一分鐘就copy and paste一次,每次將新的資料貼到上次paste的資料的下方,直到10:00時結束,然後另存新檔成file_yyyy_mmdd (file_年年年年_月月天天)。工作檔案是一直開著,永遠不關,10:00結束另存新檔後自動刪除paste在工作頁的資料。

如此,每天自動執行

十分感謝!

2 個解答

評分
  • 1 0 年前
    最佳解答

    Option Explicit

    '宣告API

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _

    ByVal lpClassNams As String, _

    ByVal lpWindowName As String) As Long

    Private Declare Function SHFileOperation Lib "shell32.dll" Alias _

    "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

    Private Type SHFILEOPSTRUCT

    hwnd As Long

    wFunc As Long

    pFrom As String

    pTo As String

    fFlags As Integer

    fAnyOperationsAborted As Long

    hNameMappings As Integer

    lpszProgressTitle As String

    End Type

    Public BackupInterval As Date

    Private prow As Long

    Private NextRunTime As Date

    '開啟檔案時自動啟動計時器

    Private Sub auto_open()

    prow = 1

    Call StartTimer

    End Sub

    '關閉檔案時停止計時

    Private Sub auto_close()

    On Error Resume Next

    StopTimer

    End Sub

    Sub Start() '手動啟動(半途停止再啟動用)

    prow = 1

    Call StartTimer

    End Sub

    '啟動計時

    Sub StartTimer()

    If Hour(Now()) >= 8 And Hour(Now()) <= 10 Then '8點到10點之間

    If Second(Now()) = 0 Then '秒數是0表示是整數分鐘則複製資料

    Range("A1:D10").Select

    Selection.Copy

    Range("H" & CStr(prow) & ":K" & CStr(prow + 9)).Select

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

    prow = prow + 10 '往下移10行

    End If

    End If

    If Hour(Now()) = 10 And Minute(Now()) = 5 And Second(Now()) = 0 Then '10點5分整存檔

    prow = 1 '行數回歸到 1

    Call SaveAsFile

    Columns("H:K").Select '清除資料

    Selection.ClearContents

    End If

    '1 秒鐘後再次執行程序 StartTimer

    NextRunTime = Now + TimeValue("0:0:1")

    Application.OnTime EarliestTime:=NextRunTime, Procedure:="StartTimer", Schedule:=True

    End Sub

    '停止計時

    Sub StopTimer()

    '停止先前由 OnTime 設定欲執行的程序

    Application.OnTime EarliestTime:=NextRunTime, Procedure:="StartTimer", Schedule:=False

    End Sub

    2010-03-06 22:31:51 補充:

    其實要定時複製資料並不難

    難的是要在只要檔案不變之下

    將檔案資料另存新檔

    (一般另存新檔則檔案會跳到新存的檔案去)

    而且要將程式碼的部份剔除掉

    (存過去的檔案不要有程式只有資料)

    所已重點在

    Call SaveASFile

    的SaveASFile這個程式

    它是用API的方式達成的

    2010-03-06 22:38:42 補充:

    由於字數太多無法一一貼上

    請自行下載吧

    http://uploadrobots.com/PPPghF

    2010-03-06 22:43:30 補充:

    如果檔案名稱不是你所要的

    你可以自行修改GetSaveAsFileName 這個函數

    如把

    GetSaveAsFileName = ThisWorkbook.Path & "\"

    改成

    GetSaveAsFileName = ThisWorkbook.Path & "\file_"

    之類的

    祝您使用愉快^^

  • 6 年前

    想要賺錢嗎???

    我覺得比基金.股票.黃金.定存 等等 都還要穩

    利息也算OK的網路投資 一次終身 希望你可以來看看

    http://migre.me/iFiHM 我的部落落~~

    +我臉書~ 詳細可以加我好友

    https://www.facebook.com/profile.php?id=1000021987...

    我有專屬臉書社團 還有很多不需要錢就可以賺到 的事業 也歡迎你歐

還有問題?馬上發問,尋求解答。