Board logo

標題: 關於程式碼這一段請問有人會改嗎? [打印本頁]
作者: vavashop    時間: 2015-6-5 20:01     標題: 關於程式碼這一段請問有人會改嗎?

這個vba我是想放在 我的 "上市三大法人買賣超"分頁  , 可以指定下載到這一個分頁
該怎麼修改大大給的程式碼呢?

Option Explicit
Sub EX()
    Dim xDate As Date, genpage As String, qdate As String, Print_php As String, Wb As Workbook
   
    '1 如不可查詢當日 三大法人買賣超日報
    xDate = Date - 1
   
   
    Do While Weekday(xDate, vbMonday) >= 6
        xDate = xDate - 1
    Loop
   
    '如於一定的時間後可查詢當日的 三大法人買賣超日報
    '請刪除 ** xDate = Date - 1 **
   
   
    '2 執行下面的程式碼,取消註解 ** ' **
   
    'If xDate = Date And Time < #5:00:00 PM# Then
    '    xDate = xDate - 1
    'End If
   
    For Each Wb In Workbooks
        If Trim(Wb.Name) = "print.php" Then Wb.Close False
        '下載CSV 的名稱為 Print_php 必先關閉
    Next
    genpage = Format(xDate, "yyyymm/yyyymmdd")
    qdate = Format(xDate, "yyyymmdd")
    Print_php = "http://www.twse.com.tw/ch/trading/fund/T86/print.php?edition=ch&filename=genpage/" _
             & genpage & "_2by_issue.dat&type=csv&select2=ALLBUT0999&qdate=" & qdate

     Set Wb = Workbooks.Open(Print_php)
End Sub
作者: GBKEE    時間: 2015-6-7 15:49

回復 1# vavashop
試試看
  1. Option Explicit
  2. Sub EX()
  3.     Dim xDate As Date, genpage As String, qdate As String, Print_php As String, Wb(1 To 2) As Workbook
  4.     Set Wb(1) = Workbooks("上市三大法人買賣超") ' "上市三大法人買賣超"分頁
  5.    
  6.     '***三大法人買賣超日報    幫你查詢過,
  7.     '[營業時間內]只能查看前一個營業日的報表.
  8.     '所以 [營業時間內] 查詢日 : xDate = Date - 1
  9.     xDate = Date
  10.     If Time < #2:00:00 PM# Then  '[營業時間內] **
  11.         Do While Weekday(xDate, vbMonday) = 1 Or Weekday(xDate, vbMonday) >= 6  '排除 週日,週六,週一
  12.             xDate = xDate - 1
  13.         Loop
  14.     ElseIf Time > #2:00:00 PM# Then  '[營業時間後] 請調整:台證交易所資料整理完畢的時間
  15.         Do While Weekday(xDate, vbMonday) >= 6  '排除 週日,週六
  16.             xDate = xDate - 1
  17.         Loop
  18.     End If
  19.     For Each Wb(2) In Workbooks
  20.         If Trim(Wb(2).Name) = "print.php" Then Wb(2).Close False     '下載CSV 的名稱為 Print_php 必先關閉
  21.     Next
  22.     genpage = Format(xDate, "yyyymm/yyyymmdd")
  23.     qdate = Format(xDate, "yyyymmdd")
  24.     Print_php = "http://www.twse.com.tw/ch/trading/fund/T86/print.php?edition=ch&filename=genpage/" _
  25.              & genpage & "_2by_issue.dat&type=csv&select2=ALLBUT0999&qdate=" & qdate

  27.      Set Wb(2) = Workbooks.Open(Print_php)
  28.      Wb(2).Sheets(1).Copy Wb(1).Sheets(1)
  29. End Sub
複製代碼
作者: vavashop    時間: 2015-6-7 20:01

謝謝大大~~

跪拜跪拜
作者: vavashop    時間: 2015-6-8 18:46

Set Sh = Sheets.Add         '新增的工作表
    Rng.AutoFilter 1, "A"       '*** 請修改你的自動篩選 條件 ***
    With Sh '新增的工作表
        Rng.Copy .[A1]          '複製 已自動篩選的範圍

大大我在新增工作表後要抓取 頁面的部份還是會有問題
可以直接有所謂 抓整個excel 頁面的 方式嗎?
因為我的比例都是固定的 就是頁面拍照這樣



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