返回列表 上一主題 發帖

[分享] 大盤每月每天歷史成交量與金額下載

回復 60# 198188
如這裡一樣嗎?
那網頁在哪裡?

TOP

回復 62# 198188
抱歉只能幫到 [貨櫃號碼登錄] 這裡
http://www.maerskline.com/appmanager/maerskline/public?_nfpb=true&_nfls=false&_pageLabel=page_tracking3_trackSimple網頁
的貨物資料,一直無法下載到Excel
  1. Option Explicit
  2. Sub 貨櫃號碼登錄()
  3.    Dim IE As New InternetExplorer, i As Integer, vDoc As Object
  4.     '宣告 Dim ie As New InternetExplorer
  5.     '須在工具-> 設定引用項目加入 新增引用 Microsoft Internet Controls
  6.     'Set IE = CreateObject("InternetExplorer.Application")
  7.     'Dim i As Integer, vDoc As Object
  8.     With CreateObject("InternetExplorer.Application") '不需新增引用 Microsoft Internet Controls
  9.     'With IE
  10.         .Visible = True
  11.         .Navigate "http://www.maerskline.com/appmanager/"
  12.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  13.         Set vDoc = .Document.getElementsByTagName("INPUT")
  14.         For i = 0 To vDoc.Length - 1
  15.             If vDoc(i).Name = "portlet_quickentries_2{actionForm.trackNo}" Then vDoc(i).Value = "PONU4867818"  '貨櫃號碼
  16.             If vDoc(i).Value = "Track" Then vDoc(i).Click               '按下確定
  17.         Next
  18.     End With
  19. End Sub
複製代碼


    回復 63# 198188
21 # stillfish00 已提出修正 ,你試試看,真不行再說

TOP

回復 65# 198188
此回覆:已是偏離這主題,以後請在有相關的主題中發問
試試看
  1. Option Explicit
  2. Sub Ex()
  3.    Dim Rng As Range
  4.    'With Workbooks.Open("C:\USER\DESTOP\E.XLSX").Sheets("2012") '檔案未開啟時用此程式碼
  5.    With Workbooks("E.XLSX").Sheets("2012")                      '檔案已開啟時用此程式碼
  6.         'A2:AM2 to A100:AM100 是Y:\2012\A.XLSX (2012) 的資料
  7.         Set Rng = .[A2]
  8.         With Workbooks.Open("Y:\2012\A.XLSX").Sheets("2012")    '檔案開啟
  9.             .[A100:AM100].Copy Rng
  10.            .Parent.Close False                                  '檔案關閉
  11.         End With
  12.         'A101:AM101 to A150:AM150是C:\2012\B.XLSX (Nov)的資料
  13.         Set Rng = .[A101]
  14.         With Workbooks.Open("Y:\2012\A.XLSX").Sheets("Nov")    '檔案開啟
  15.             .[A150:AM150].Copy Rng
  16.            .Parent.Close False                                  '檔案關閉
  17.         End With
  18.         'A151:AM151 to A270:AM270是Z:\2012\C.XLSX (2012) 的資料
  19.         Set Rng = .[A151]
  20.         With Workbooks.Open("Y:\2012\A.XLSX").Sheets("2012")    '檔案未開啟
  21.             .[A270:AM270].Copy Rng
  22.            .Parent.Close False                                  '檔案關閉
  23.         End With
  24.     End With
  25. End Sub
複製代碼

TOP

回復 67# 198188
是這樣嗎?
  1. Option Explicit
  2. Sub EX()
  3.     '
  4.     '
  5.     Set Rng = .[A2]  '第一個Rng
  6.     '
  7.     '
  8.     'Set Rng = .[A101]  '第二個Rng
  9.     '第二個Rng改成如此第一個Rng往下到有資料的下一列
  10.     Set Rng = Rng.End(xlDown).Offset(1)  '第二個Rng
  11.     '
  12.     '
  13.     'Set Rng = .[A151]  '第三個Rng
  14.     '第三個Rng改成如此第二個Rng往下到有資料的下一列
  15.     Set Rng = Rng.End(xlDown).Offset(1) '第三個Rng
  16.     '
  17.     '
  18. End Sub
複製代碼

TOP

回復 71# pupai
'http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php 這網址可下載檔案但不是csv檔,你可以試下載看看
你的網址少了 STK_NO (股票代號)
  1. xlTheFile = "http://www.twse.com.tw/ch/trading/exchange/FMTQIK/FMTQIK2.php?STK_NO=" & Stk_No & "&myear=" & xlTheYear & "&mmon=" & xlTheMonth & "&type=csv"
  2.     xlTheFile = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?STK_NO=" & Stk_No & "&myear=" & xlTheYear & "&mmon=" & xlTheMonth
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2013-9-19 20:58 編輯

回復 73# pupai
試試看
  1. Option Explicit
  2. Private Sub 大盤成交資訊()
  3.     Dim xlTheYear As String, xlTheMonth As String, STK_NO As String, xlTheFile As String, AR
  4.     Dim Sh As Worksheet
  5.     xlTheYear = Format(Range("C1"), "0000")  '修改字串格式
  6.     xlTheMonth = Format(Range("C2"), "00")   '修改字串格式
  7.     STK_NO = Format(Range("C3"), "0000")  '修改字串格式
  8.     Set Sh = ThisWorkbook.Sheets.Add         '新增工作表
  9.     Sh.Name = xlTheYear & "_" & xlTheMonth   '新增工作表命名
  10.     '******http://www.twse.com.tw/ch/trading/exchange/FMTQIK/FMTQIK2.php*****
  11.     'xlTheFile = "http://www.twse.com.tw/ch/trading/exchange/FMTQIK/FMTQIK2.php?STK_NO=" & STK_NO & "&myear=" & xlTheYear & "&mmon=" & xlTheMonth & "&type=csv"
  12.    
  13.      '******http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php*****
  14.      xlTheFile = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?STK_NO=" & STK_NO & "&myear=" & xlTheYear & "&mmon=" & xlTheMonth
  15.     '**************************************************************
  16.     With Workbooks.Open(xlTheFile)
  17.         If InStr(xlTheFile, "BWIBBU") Then
  18.             AR = .Sheets(1).Range("b446").CurrentRegion 'http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php
  19.         Else
  20.             .Sheets(1).UsedRange.Copy Sh.[A1]
  21.          End If
  22.           .Close 0

  23.     End With
  24.     With Sh
  25.         If InStr(xlTheFile, "BWIBBU") Then .Range("A1").Resize(UBound(AR, 1), UBound(AR, 2)) = AR
  26.         .Cells.EntireColumn.AutoFit            '調整欄寬
  27.         .Columns("A:A").ColumnWidth = 28.56
  28.     End With
  29. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 76# rinkenny
試試看
  1. Option Explicit
  2. Private Sub 大盤成交資訊()
  3.     Dim xlTheYear As String, xlTheMonth As String, STK_NO As String, xlTheFile As String,  Sh As Worksheet
  4.     With Sheets("Sheet1")
  5.         xlTheYear = Format(.Range("C1"), "0000")  '修改字串格式
  6.         xlTheMonth = Format(.Range("C2"), "00")   '修改字串格式
  7.         STK_NO = Format(.Range("C3"), "0000")  '修改字串格式
  8.     End With
  9.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''
  10.     Set Sh = Workbooks("你指定的活頁簿").Sheets("歷史資料")
  11.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''
  12.     '******http://www.twse.com.tw/ch/trading/exchange/FMTQIK/FMTQIK2.php*****
  13.     xlTheFile = "http://www.twse.com.tw/ch/trading/exchange/FMTQIK/FMTQIK2.php?STK_NO=" & STK_NO & "&myear=" & xlTheYear & "&mmon=" & xlTheMonth & "&type=csv"
  14.         With Workbooks.Open(xlTheFile)
  15.         .Sheets(1).UsedRange.Copy Sh.Range("A" & Rows.Count).End(xlUp).Offset(1) '接著A欄 複製下去
  16.         .Close 0
  17.     End With
  18. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 要用心,不要操心、煩心。
返回列表 上一主題