標題:
抓4個網頁合併一份資料,2個輸入欄位寫法請教(年,月)
[打印本頁]
作者:
bioleon69
時間:
2017-5-2 15:55
標題:
抓4個網頁合併一份資料,2個輸入欄位寫法請教(年,月)
本帖最後由 bioleon69 於 2017-5-2 15:58 編輯
從觀測站進去有8個選項
http://mops.twse.com.tw/mops/web/t21sc04_ifrs
如圖
[attach]27136[/attach]
國內上市http://mops.twse.com.tw/nas/t21/sii/t21sc03_106_3_0.html
國外上市http://mops.twse.com.tw/nas/t21/sii/t21sc03_106_3_1.html
國內上櫃http://mops.twse.com.tw/nas/t21/otc/t21sc03_106_3_0.html
國外上櫃http://mops.twse.com.tw/nas/t21/otc/t21sc03_106_3_1.html
我想將前四個選項
裡面的網頁表格內容,全部寫入同一份excel
excel裡面就放兩個輸入的欄位
年跟月
請問有什麼方法可以這樣寫?
目前是只會寫一個網址進去,用qt
也還沒設定年月分別在a1,b1輸入
Sub 月營收()
Call 清除外部資料
UsedRange.Clear
Set keyin = ActiveSheet
Set Show = keyin.QueryTables _
.Add(Connection:="URL;http://mops.twse.com.tw/nas/t21/sii/t21sc03_106_3_0.html", _
Destination:=keyin.Cells(1, 1))
With Show
.Name = "暫存資料"
.RefreshStyle = xlInsertEntireRows
.AdjustColumnWidth = False
.RefreshPeriod = 0 '關閉定時更新
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone ' 無格式
.Refresh BackgroundQuery:=False
End With
End Sub
Sub 清除外部資料()
Dim sh As Worksheet, qyt As QueryTable
For Each sh In ActiveWorkbook.Worksheets
For Each qyt In sh.QueryTables
qyt.Delete
Next
Next
End Sub
複製代碼
qt
msxml2
InternetExplorer.Application
只能稍微看得懂一點點一點點這三種的方法= =
盼大大們教學指教
作者:
bioleon69
時間:
2017-5-8 06:08
先不用勞煩大大,不好意思
目前程式碼以更動
沒打算用QT了
目前已XML為主
謝謝
作者:
bioleon69
時間:
2017-5-12 07:49
本帖最後由 bioleon69 於 2017-5-12 07:51 編輯
回復
2#
bioleon69
請教大大!
目前用QT匯入網頁資料
有4個URL
4個SUB不同的地方就是,URL跟.NAME的部分
不知道有沒有辦法合併成一個SUB?(我現在是跑4個SUB,只有URL跟NAME不一樣)
這樣執行感覺是同樣的東西跑4次,速度跟效率上都似乎都差了,所以來請教前輩們
有沒有可以變成一個的方法
目前是用一個sub然後
call test
call test1
call test2
call test3
然後test,test1,test2,test3 就url跟.name不同
Sub TEST()
With ActiveSheet.QueryTables.Add(Connection:="URL;http://mops.twse.com.tw/nas/t21/sii/t21sc03_" & ccyear & "_" & ccmonth & "_0.html", Destination:=Range("B" & maxr + 5))
.Name = "TEST"
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.RefreshStyle = xlOverwriteCells
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
End Sub
複製代碼
作者:
GBKEE
時間:
2017-5-12 09:11
回復
3#
bioleon69
Option Explicit '在模組層次中強迫每個在模組�堛瘍僂くㄔ眸楨�確的宣告。
Sub Ex()
Dim Ar1(), Ar2(), i As Integer
Ar1 = Array("http://mops.twse.com.tw/nas/t21/sii/t21sc03_", "XXX1", "XXX2", "XXX3")
Ar2 = Array("TEST1", "TEST2", "TEST3", "TEST4")
For i = 0 To UBound(Ar1)
TEST Ar1(i), Ar2(i)
Next
End Sub
Sub TEST(ByVal xUrl As String, ByVal xName As String)
With ActiveSheet.QueryTables.Add(Connection:="URL;" & xUrl & ccyear & "_" & ccmonth & "_0.html", Destination:=Range("B" & maxr + 5))
.Name = xName
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.RefreshStyle = xlOverwriteCells
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
End Sub
複製代碼
作者:
bioleon69
時間:
2017-5-13 12:54
回復
4#
GBKEE
收到!趕緊來測試一下看看!
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)