Board logo

標題: 請求師兄協助,小弟不懂完成語法 [打印本頁]
作者: bully    時間: 2018-5-10 17:07     標題: 請求師兄協助,小弟不懂完成語法

小弟爬文後只做到時間開關,其它是錄製出來的。
我希望下面模組能改為每次貼上時,
向右欄位加1欄即第1次是c3下1次是d3...e3...
請問要如何更改?
Dim s As String
Sub 開始()
If s <> "停止" Then
Application.OnTime Now + TimeValue("00:30:00"), "開始"
Call pop_1
End If
s = ""
End Sub

Sub pop_1()
'
' pop_1 巨集
'
    Range("A3:A22").Select
    Selection.Copy
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
End Sub

Sub 停止()
s = "停止"
End Sub
作者: iamaraymond    時間: 2018-5-10 17:29

回復 1# bully

不太了解您的問題，是希望每次執行程式時，可以自動向右邊一欄貼上?
EX:第一次執行>貼在B欄
第二次執行>貼在C欄?

時間開關與此的關聯是甚麼呢?
作者: bully    時間: 2018-5-10 17:48

本帖最後由 bully 於 2018-5-10 17:50 編輯

回復 2# iamaraymond

謝謝師兄回復
我想法是第一次開始是在c3,30分後d3貼上,
再30分後e3貼上
作者: iamaraymond    時間: 2018-5-10 17:53

回復 3# bully

所以是每30分鐘貼一次嗎?那停止的條件是?
作者: bully    時間: 2018-5-10 18:01

回復 4# iamaraymond


    我本想法是貼上20次後自動停止,
     因不會寫,所以用手動停止運作!
作者: iamaraymond    時間: 2018-5-10 18:10

回復 5# bully

不知這樣是否符合您的需求
  1. Sub test()

  3. For i = 1 To 20
  4.     Range("A3:A22").Copy
  5.     Cells(3, i + 2).PasteSpecial Paste:=xlPasteValues
  6.     Application.Wait Now() + TimeValue("00:00:01")
  7. Next
  8. Application.CutCopyMode = False
  9. [A1].Select
  10. End Sub
複製代碼
我是先測試1秒，如果您覺得OK，可以將timeValue修改為 TimeValue("00:30:00")
作者: bully    時間: 2018-5-10 18:48

回復  bully

不知這樣是否符合您的需求我是先測試1秒，如果您覺得OK，可以將timeValue修改為 TimeValue ...
iamaraymond 發表於 2018-5-10 18:10


謝謝師兄,我就是這個意思,但是這個test會長期處於運行中,
因我只需30分執行1次,直至20次完成停止,(表單內其它動作不能做)
,可否改為每30分叫醒1次?
作者: quickfixer    時間: 2018-5-10 20:39

本帖最後由 quickfixer 於 2018-5-10 20:43 編輯

回復 7# bully
01 學來的,這個方法不會讓excel停住,表單還可以正常做別的事
  1. Public i As Integer

  3. Sub 開始()
  4.     i = 0
  5.     Call test
  6. End Sub

  8. Sub test()
  9.        If i > 20 Then Exit Sub
  10. '下面這2行,換成你要跑的程式
  11.     i = i + 1
  12.     Cells(1, 1) = i
  13.     Application.OnTime Now + TimeValue("00:00:02"), "test"
  14. End Sub

  16. Sub 停止()
  17.    i=21
  18. End Sub
複製代碼
作者: bully    時間: 2018-5-10 21:28

回復 8# quickfixer


    成功了,多謝2位大大協助!!
作者: iamaraymond    時間: 2018-5-10 21:35

回復 7# bully
  1. Dim total As Integer


  4. Sub test()

  6. If total < 5 Then
  7.     total = total + 1
  8.     Debug.Print total
  9.     Application.OnTime Now() + TimeValue("00:00:10"), "Thisworkbook.test1"
  10. Else
  11.     Application.CutCopyMode = False
  12.     [A1].Select
  13. End If

  15. Application.CutCopyMode = False
  16. [A1].Select
  17. End Sub
  18. Sub test1()
  19.     Range("A3:A22").Copy
  20.     Cells(3, total + 2).PasteSpecial Paste:=xlPasteValues
  21.     Call test
  22. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)