麻辣家族討論版版 - Powered by Discuz! Board

標題: [分享] VBA 語句集 200 句 [打印本頁]

作者: c_c_lai 時間: 2012-4-15 15:17 標題: VBA 語句集 200 句

之前 ajagow 大大分享了達人總結的VBA精典的""八""類百條語句版，
小弟個人為尋求解決程式問題上網找尋資料，卻發現了 VBA 語句集 200 句的分享，
其中前半段是第一輯的達人總結的VBA精典的""八""類百條語句版、以及第 2 輯的
VBA 語句集 100 句，同時也為了個人閱覽方便與正確性，所以稍稍加以整理一下，
並將它貼示出來與大家來共同分享研習，以祈麻辣家族討論族的各位都將成為麻辣強手！

因帖子長度不符合要求。當前長度: 29456 字節系統限制: 10 到 10000 字節
所以只能使用附件貼上。

[attach]10446[/attach]

作者: ajagow 時間: 2012-4-15 21:07

謝謝C C LAI無私地分享
就是要來讓麻辣家族變得更強
這樣的回覆好像有衝犯版規
請版大人原諒
今天是那個盤中 DDE 存檔與 VBA 的實際應用範例程式，真的很順手
茅塞頓開

作者: c_c_lai 時間: 2012-4-16 13:26

抽空又將 VBA 語句集 200 句從文字檔 (Text) 整理至 Adobe Reader 的 PDF 檔，
更方便閱覽，順便一同將它分享出來！
敬請笑納。

[attach]10456[/attach]

作者: ajagow 時間: 2012-4-25 20:28

本帖最後由 ajagow 於 2012-4-25 20:31 編輯

回復 11# chenua

' 盤中 DDE 存檔的實際應用範例
Option Explicit
Dim actEnabled As Boolean
Dim index As Single

Private Sub Workbook_Open()

If (Sheets("工作表1").Range("AA1").Value = "") Then Sheets("工作表1").Range("AA1").Value = "08:45:00" ' 假設AA1欄位為空白，則寫入開盤起始時間

If (Sheets("工作表1").Range("AA2").Value = "") Then Sheets("工作表1").Range("AA2").Value = "13:45:59" ' AA2欄位亦同。(此兩欄紀錄起始終止時間)

If (Sheets("工作表1").Range("AA3").Value = "") Then Sheets("工作表1").Range("AA3").Value = 0          ' 紀錄最後資料匯入之列號 (Rows)。

If (Sheets("工作表1").Range("AA4").Value = "") Then Sheets("工作表1").Range("AA4").Value = "00:00:10" ' 紀錄資料匯入相隔時間，如每隔十秒寫入一次。

If (TimeValue(Now) > Sheets("工作表1").Range("AA2").Value) Then    ' 如果目前時間業已超過AA2的時段，則呼叫.......

      Call stopProcedure

Else                                                                ' 反之，則呼叫.......

   Call startProcedure

End If

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

On Error Resume Next

Call actStop

End Sub

Private Sub startProcedure()    ' 保留作為控制項之應用程序，如按鈕之巨集應用等。

Call actStart

End Sub

Private Sub stopProcedure()       ' 保留作為控制項之應用程序，如按鈕之巨集應用等。

  Call actStop

End Sub

Sub Starter()

If (actEnabled = True And TimeValue(Now) >= Sheets("工作表1").Range("AA1").Value And TimeValue(Now) <= Sheets("工作表1").Range("AA2").Value) Then

   index = Sheets("工作表1").Range("AA3").Value

      If (Index = 0) Then Call newTitle  '假設newTitle程序(由使用者自行定義)是將第一列的資料抬頭名稱寫入到工作表2。如：日期、時間、R1C5的對應欄位資料等。

      Sheets("工作表1").Range("AA3").Value = index + 1    ' 紀錄列號加一。

      Sheets("工作表2").Cells(index + 2, 1).Value = Date

      Sheets("工作表2").Cells(index + 2, 2).Value = TimeValue(Now)

   ' Sheets("工作表2").Cells(index + 2, 3).Value = Sheets("工作表1").Cells(1, 5).Value

      '

   ' 複製從券商DDE匯入之相對應位置資料，如 R1C5 對應的可能是收盤價等等。

      '

End If

End Sub

Sub onStarter()

Call Starter

If actEnabled Then Call actStart

End Sub

Sub actStart()

actEnabled = True

Application.OnTime (Now + Sheets("工作表1").Range("AA4").Value), "ThisWorkBook.onStarter" ' 寫入資料的排程 (目前是每隔十秒寫入一次)

End Sub

Sub actStop()

actEnabled = False

On Error Resume Next

Application.OnTime Now, "ThisWorkBook.onStarter", , False

End Sub

這是 C C LAI 大大的程式
感謝您們

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