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

標題: 新版股市公開資訊觀測站的資料抓到EXECL? [打印本頁]

作者: xisun2002 時間: 2013-11-14 09:13 標題: 新版股市公開資訊觀測站的資料抓到EXECL?

之前舊版的公開資訊觀測站的資料，用
[ 資料 ] -> [ 匯入外部資料 ] -> [ 新增WEB查詢 ]
http://mopsov.tse.com.tw/server-java/t05st22?colorchg=1&off=1&TYPEK=["where"]&isnew=true&year=["year"]&co_id=["stockid"]&
就可以自動匯入財報等資料到excel作分析，
新股市公開資訊觀測站一改版後格式不同，此功能就無法使用此功能，請問有人能幫忙看一下要如何改，才能自動查詢相關資料?
-----------------------------------------------------------------------------------------------------------------------------------------------------
我想匯入excel的網頁有：
http://mops.twse.com.tw/mops/web/t164sb03 合併資產負債表

http://mops.twse.com.tw/mops/web/t164sb04 合併綜合損益表

http://mops.twse.com.tw/mops/web/t164sb05 合併現金流量表

希望可以提供方法，因為有很多報表要抓。

作者: xisun2002 時間: 2013-11-14 16:20

急求助！
希望哪位大大可以幫忙解大

作者: GBKEE 時間: 2013-11-14 17:36

回復 2# xisun2002
程式區找找有'http://mops.twse.com.tw/mops/web的資訊

作者: xisun2002 時間: 2013-11-14 19:04

希望用EXCEL匯入外部資料功能來做，希望知道的大大幫幫忙

作者: pupai 時間: 2013-11-26 17:45

回復 3# GBKEE

請教GBKEE兄
程式區http://forum.twbts.com/viewthrea ... p;extra=&page=2
其附件只適合舊版的公開資訊站
新版的公開資訊站並無法檢視,
請坂大幫忙修改謝謝!!

作者: GBKEE 時間: 2013-11-26 18:18

回復 5# pupai
每一網頁的建置不同,要看網頁內容修改程序的.

作者: pupai 時間: 2013-11-26 19:21

回復 6# GBKEE

依照這三個網址
http://mops.twse.com.tw/mops/web/t164sb03 合併資產負債表
http://mops.twse.com.tw/mops/web/t164sb04 合併綜合損益表
http://mops.twse.com.tw/mops/web/t164sb05 合併現金流量表
煩請版主撥空幫忙
謝謝

作者: GBKEE 時間: 2013-11-27 10:46

回復 7# pupai

[attach]16882[/attach]

按下圖片的網址 http://mops.twse.com.tw/server-j ... N=3&REPORT_ID=C

Option Explicit
Sub Ex()
Dim URL As String, xCo_Id As String, xSyear As String, xSseason As String
xCo_Id = "[" & """股票代號""" & "," & """2485""" & "]" '要求輸入網頁的參數:股票代號
xSyear = "[" & """年度""" & "," & """" & Format(Date, "e") & """" & "]" 'Format(Date, "e")->中華民國的年度
xSseason = "[" & """季別""" & "," & """" & Format(Date, "q") & """" & "]" 'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
.AdjustColumnWidth = False '自動調整欄寬
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,3,4" '資產負債表,綜合損益表,現金流量表
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub

複製代碼

作者: pupai 時間: 2013-11-27 11:50

回復 8# GBKEE

收到衷心感謝 !!
PS:如果GBKEE兄或家族考慮出一本 VBA抓股市的書我一定訂10本謝謝!!

作者: BigDog 時間: 2014-2-16 21:54

回復 8# GBKEE

Dear 超版大,

下圖找不到你上述說的網址，在公開資訊觀測站-->營運概況-->財務公析資料，請超版大解惑哪裡可以修改網址的股市代號...非常感謝...
[attach]17509[/attach]

作者: GBKEE 時間: 2014-2-17 09:46

回復 10# BigDog
網址:公開資訊觀測站-->營運概況-->財務比率分析->採IFRSs後->財務分析資料

Option Explicit
Sub 公開資訊網頁()
Dim A As Object, E As Object
With CreateObject("InternetExplorer.Application")
.Visible = True
' .Navigate "http://mops.twse.com.tw/mops/web/t164sb04" '網址:綜合損益表
'.Navigate "http://mops.twse.com.tw/mops/web/stapap1" '網址:董監事持股餘額明細資
.Navigate "http://mops.twse.com.tw/mops/web/t05st22"
'網址:公開資訊觀測站-->營運概況-->財務比率分析->採IFRSs後->財務分析資料
Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
' .document.getElementById("isnew").Value = "false" '選擇: 歷史資料
'註解上一行程式碼為 -> 選擇: 最新資料,不會執行 If 內程式碼
If .document.getElementById("isnew").Value = "false" Then
.document.getElementById("isnew").FireEvent ("onchange")
.document.getElementById("year").Value = "102" '年度
.document.getElementById("season").Value = "01" '綜合損益表:季別
.document.getElementById("month").Value = "08" '董監事持股餘額明細資料:月份
End If
'********************************************************************
For Each A In .document.getelementSbyTAGNAME("INPUT")
'If A.Name = "co_id" Then A.Value = "2317"
If A.Name = "co_id" Then A.Value = ActiveSheet.Range("A1") '儲存格:指定代號
If A.Value = " 搜尋 " Then A.Click '按下搜尋
Next
Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
For Each E In .document.ALL.TAGS("div")
If E.ID = "table01" Then
.document.body.innerHTML = E.outerHTML
Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
With ActiveSheet
.UsedRange.Offset(1).Clear
.Cells(2, 1).Select
.PasteSpecial Format:="HTML"
End With
End If
Next
.Quit '關閉 IE
End With
End Sub

複製代碼

作者: PKKO 時間: 2015-7-16 21:18

回復 11# GBKEE

超版大大問一下哦,您是如何得知網址後面的選項的?實在太強大了...
http://mops.twse.com.tw/mops/web/t164sb04 =>後面有season 、 year 如何得知的?

例如:http://lbma.oblive.co.uk/table
這是倫敦黃金的公告價格網站
我只會抓104年的,因為我不曉得後面要如何輸入year 的變數取得不同年度的資料
請問類似這種網頁該如何找出後面的變數輸入方式
以及這個網址的變數要如何輸入?

作者: joey0415 時間: 2015-7-17 00:01

回復 GBKEE

超版大大問一下哦,您是如何得知網址後面的選項的?實在太強大了...
http://mops.twse. ...
PKKO 發表於 2015-7-16 21:18

http://lbma.oblive.co.uk/table?metal=silver&year=2008&type=monthly

http://lbma.oblive.co.uk/table?metal=gold&year=2013&type=daily

自己練習改改看

作者: PKKO 時間: 2015-7-17 02:11

回復 13# joey0415

joey0415大大您好,您給我細部網址之後,我就會改了
可是您的細部網址是如何得知的?

例如:http://lbma.oblive.co.uk/table => 從這裡開始(?metal=silver&year=2008&type=monthly)
紅色字串的地方您怎麼知道有這段網址?
我猜也猜不到阿~
還是要看網頁的檢視程式嗎?

作者: GBKEE 時間: 2015-7-17 05:30

回復 14# PKKO
慢慢的體會

Option Explicit
Sub Ex_網頁元素()
Dim i As Integer, E As Object
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://mops.twse.com.tw/mops/web/t164sb04"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Stop
'在這網址輸入相關資料,再繼續執行下面的程式
With .Document '網頁的文件
'*** 這段程式碼可查看這網頁的元素內容
On Error Resume Next
For Each E In .all
i = i + 1
Cells(i, "a") = E.tagname '控制項標記的名稱
Cells(i, "b") = E.ID '控制項標記的ID (惟一的)
Cells(i, "c") = E.Name '控制項標記的命名
Cells(i, "d") = E.Value '控制項標記的值
Cells(i, "e") = E.innertext '控制項標記的文字
Cells(i, "f") = E.Type '控制項標記的類型
Cells(i, "g") = E.href '控制項標記的網址
Next
'****************************************
End With
' .Quit '關閉網頁
End With
'執行後到工作表上,查看在這網址輸入相關資料的控制項的屬性
End Sub

複製代碼

作者: PKKO 時間: 2015-7-17 10:27

回復 15# GBKEE

哇~太感謝超版大大了，我會慢慢體會的!謝謝~

作者: bobomi 時間: 2015-7-17 10:35

回復 14# PKKO

IE 的 URL 框不就有了

作者: ftc693 時間: 2015-7-17 12:00

回復 PKKO

IE 的 URL 框不就有了
bobomi 發表於 2015-7-17 10:35

你可試試看，有些東西沒有你想得那麼簡單喔

URL一般都只有初始頁面

作者: bobomi 時間: 2015-7-17 14:15

本帖最後由 bobomi 於 2015-7-17 14:21 編輯

你可試試看，有些東西沒有你想得那麼簡單喔

URL一般都只有初始頁面
ftc693 發表於 2015-7-17 12:00

我知道有些不行啊
但我回的是 http://lbma.oblive.co.uk/table?metal=silver&year=2008&type=monthly 這個網頁

主要是 post 網頁 ( 端看對方要不要給你方便 )
不想給你直接下載的, 網址後面就不會直接放參數, 但可以找出來
還有更狠一點的
為了不讓你抓
經常改變網址參數

作者: PKKO 時間: 2015-7-17 15:06

回復 19# bobomi

妳說的URL框指的是寫網址的地方嗎?

我一開始查到的網址只有這樣=> http://www.lbma.org.uk/pricing-and-statistics

是joey0415大大提供後面的網址,我才知道參數

後來超版大大提供我學習得到參數的方法

因此還在學習中= =

作者: chang0833 時間: 2015-11-8 23:18

回復 8# GBKEE
版大這個程式真的很好用，
我是EXCEL VBA初學者，還在模索階段…痛苦學習中
可以懇請版大在大力幫忙一下，如何能一次下載最新8季的資料及在開頭列出股名或代號
感激不盡，謝謝

作者: chang0833 時間: 2015-11-10 23:54

回復 21# chang0833
請問版大，我用最笨的方式複製了八次程式(固定年度及季別)，總於可以跑出來了，可是"股票代號"可否設計一個可以自用調整的變數來輸入
"xCo_Id = "K"                '要求輸入網頁的參數:股票代號"……這一行該如何寫，或者有其它更好的方式。

煩請版大賜教了，感激不盡，謝謝。

Dim URL As String, xCo_Id As String, xSyear As String, xSseason As String

xCo_Id = "K"                '要求輸入網頁的參數:股票代號
xSyear = "102" 'Format(Date, "e")->中華民國的年度
xSseason = "2"    'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
      .AdjustColumnWidth = True                '自動調整欄寬
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "2,3,4"                '資產負債表,綜合損益表,現金流量表
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
End With

作者: GBKEE 時間: 2015-11-11 08:29

"xCo_Id = "K" '要求輸入網頁的參數:股票代號"……這一行該如何寫，或者有其它更好的方式

回復 22# chang0833

參考這裡改一下

X = Application.InputBox("請輸入篩選關鍵字")
If X = "" Or X = "False" Then Exit Sub

複製代碼

作者: chang0833 時間: 2015-11-11 11:22

回復 22# chang0833
感謝版大，代號輸入問題已經解決^^
再請版大解決一個問題，要如何使下載下來的資料，放在指定的儲存格位置??
煩請賜教了，謝謝^^

作者: chang0833 時間: 2015-11-11 14:50

版大：我執行後，網頁資料都是從第一列開始排列，在執行到下一季時會把資料往右推
，但遇到財報第四季時，因其格式與其他三季不同，導致更新資料起始不同而改變資料位置
，所以我需要把每一季的下載位置，都放在固定儲存位置，資料才不會每次都不一樣
在勞煩版大了^^謝謝

Dim URL As String, xCo_Id As String, xSyear As String, xSseason As String

K = Application.InputBox("請輸入股票代號")
X = Application.InputBox("請輸入最新年度")
Y = X - 1
Z = X - 2

xCo_Id = "" & K                '要求輸入網頁的參數:股票代號
xSyear = "" & Z 'Format(Date, "e")->中華民國的年度
xSseason = "2"    'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
      .AdjustColumnWidth = True                '自動調整欄寬
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "2,3,4"                '資產負債表,綜合損益表,現金流量表
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
End With
xCo_Id = "" & K                   '要求輸入網頁的參數:股票代號
xSyear = "" & Z 'Format(Date, "e")->中華民國的年度
xSseason = "3"    'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
      .AdjustColumnWidth = True                '自動調整欄寬
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "2,3,4"                '資產負債表,綜合損益表,現金流量表
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
End With
xCo_Id = "" & K                   '要求輸入網頁的參數:股票代號
xSyear = "" & Z 'Format(Date, "e")->中華民國的年度
xSseason = "4"    'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
      .AdjustColumnWidth = True                '自動調整欄寬
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "2,3,4"                '資產負債表,綜合損益表,現金流量表
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
End With
xCo_Id = "" & K                   '要求輸入網頁的參數:股票代號
xSyear = "" & Y 'Format(Date, "e")->中華民國的年度
xSseason = "1"    'Format(Date, "q")->當年度的季別
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("A1"))
      .AdjustColumnWidth = True                '自動調整欄寬
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "2,3,4"                '資產負債表,綜合損益表,現金流量表
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
End With

作者: GBKEE 時間: 2015-11-12 08:10

回復 25# chang0833
已修改試試看

Option Explicit
Sub Ex()
Dim URL As String, xCo_Id As String, xSyear As String, X As Integer, Rng As Range
Dim xSseason As Variant
xCo_Id = Application.InputBox("請輸入股票代號", , 2303) '預設為 2303
X = Application.InputBox("請輸入最新年度", , Year(Date) - 1911) '中華民國的年度
With ActiveSheet
For Each xSseason In .QueryTables 'WEB查詢物件集合
xSseason.Delete
Next
For Each xSseason In .Names 'Name 物件的集合
.Names(xSseason.Name).Delete
Next
.UsedRange.Clear
Set Rng = .Range("a1") '指定工作表上 WEB查詢的位置
End With
'''''''''''''''''''
For Each xSseason In Array(2, 3, 4, 1) '迴圈xSseason => 2, 3, 4, 1
xSyear = "" & IIf(xSseason > 1, X - 2, X - 1)
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Rng)
.Name = xCo_Id & "-" & xSyear & "- 第 " & xSseason & " 季" 'WEB查詢的名稱
.AdjustColumnWidth = True '自動調整欄寬
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,3,4" '資產負債表,綜合損益表,現金流量表
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
With .ResultRange 'WEB查詢資料的範圍
Set Rng = .Cells(.Rows.Count + 2, 1) '下一WEB查詢的位置
End With
End With
Next
End Sub

複製代碼

作者: chang0833 時間: 2015-11-12 15:00

回復 26# GBKEE
感謝版大的熱心回復，減輕很多學習上的困擾^^
再請教一下版大所寫的這段程式，只能將輸入最新的年度往前查前二年的資料
，但今年的資料會無法查詢，該如何讓今年的資料也可以下載，
在勞煩版大了，謝謝^^

For Each xSseason In Array(2, 3, 4, 1) '迴圈xSseason => 2, 3, 4, 1

xSyear = "" & IIf(xSseason > 1, X - 2, X - 1)

作者: GBKEE 時間: 2015-11-12 16:23

回復 27# chang0833
試試看(全部)

Option Explicit
Sub Ex()
Dim URL As String, xCo_Id As String, X As Integer, Rng As Range
Dim E As Variant, xSyear As Integer, xSseason As Integer, D_Name As String
With ActiveSheet
For Each E In .QueryTables 'WEB查詢物件集合
E.Delete
Next
For Each E In .Names 'Name 物件的集合
.Names(E.Name).Delete
Next
.UsedRange.Clear
Set Rng = .Range("a1") '指定工作表上 WEB查詢的位置
End With
xCo_Id = Application.InputBox("請輸入股票代號", , 2303) '預設為 2303
X = Year(Date) - 1910 '中華民國的年度
For xSyear = X To X - 3 Step -1 '迴圈:年度 '105->102
'For xSyear = X - 3 To X '迴圈:年度 '102->105
For xSseason = 1 To 4 ' '迴圈:季別 '1,2,3,4
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Rng)
.Name = xCo_Id & "_" & xSyear & "_第" & xSseason & "季" 'WEB查詢的名稱
.AdjustColumnWidth = True '自動調整欄寬
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,3,4" '資產負債表,綜合損益表,現金流量表
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
If .ResultRange.Rows.Count = 2 Then '無資料
D_Name = .Name 'WEB查詢的名稱
.Delete '刪除:WEB查詢
With Rng.Parent
For Each E In .Names
If InStr(E.Name, D_Name) Then E.Delete '刪除:工作表上的名稱->WEB查詢的名稱
Next
End With
Else
With .ResultRange 'WEB查詢資料的範圍
Set Rng = .Cells(.Rows.Count + 2, 1) '下一WEB查詢的位置
End With
End If
End With
Next
Next
MsgBox "Ok"
End Sub

複製代碼

作者: chang0833 時間: 2015-11-12 17:29

回復 28# GBKEE

感謝版大，目前下載沒問題了，謝謝^^
目前先來慢慢研究版大的程式，太感恩了^^

作者: c_c_lai 時間: 2015-11-13 04:54

回復 29# chang0833
回復 28# GBKEE

GBKEE 版大
假設如果將：
X = Year(Date) - 1910                '  中華民國的年度
For xSyear = X To X - 3 Step -1    ' 迴圈: 年度 ' 105->102
修改為：
X = Year(Date) - 1911                '  中華民國的年度
For xSyear = X To X - 2 Step -1    ' 迴圈: 年度 ' 104->102  最新的年度往前查前二年的資料
則本年度資訊會從『"$A$1"』位址開始列印，否則會從『"$A$13"』位址開始列印。
這隻程式非常精簡易覽，我會好好保存備錄的，謝謝 GBKEE 您的指導！

"$A$1" 2015年3月31日 2014年12月31日 2014年3月31日
"$A$282" 2015年6月30日 2014年12月31日 2014年6月30日
"$A$567" 2015年9月30日 2014年12月31日 2014年9月30日
"$A$856" 2015年第3季 2014年第3季 2015年01月01日至2015年09月30日 2014年01月01日至2014年09月30日
"$A$859" 2014年3月31日 2013年12月31日 2013年3月31日
"$A$1133" 2014年6月30日 2013年12月31日 2013年6月30日
"$A$1409" 2014年9月30日 2013年12月31日 2013年9月30日
"$A$1688" 2014年12月31日 2013年12月31日
"$A$1971" 2013年3月31日 2012年12月31日 2012年3月31日 2012年1月1日
"$A$2247" 2013年6月30日 2012年12月31日 2012年6月30日 2012年1月1日
"$A$2530" 2013年9月30日 2012年12月31日 2012年9月30日 2012年1月1日
"$A$2812" 2013年12月31日 2012年12月31日 2012年1月1日
~
"$A$3092"

複製代碼

作者: c_c_lai 時間: 2015-11-13 05:13

回復 29# chang0833
回復 28# GBKEE

GBKEE 版大沒留意您在 34. ~ 46. 間加入了 If ~ Then 的判斷語句。歹勢！

If .ResultRange.Rows.Count = 2 Then '無資料
D_Name = .Name 'WEB查詢的名稱
.Delete '刪除:WEB查詢
With Rng.Parent
For Each E In .Names
If InStr(E.Name, D_Name) Then E.Delete '刪除:工作表上的名稱->WEB查詢的名稱
Next
End With
Else
With .ResultRange ''WEB查詢資料的範圍
Set Rng = .Cells(.Rows.Count + 2, 1) ' 下一WEB查詢的位置
End With
End If

複製代碼

作者: GBKEE 時間: 2015-11-13 06:00

回復 31# c_c_lai
這網頁有點奇怪,年度的選項為何有下一年度(未來的年度).
有人可分享嗎?

作者: c_c_lai 時間: 2015-11-13 07:47

本帖最後由 c_c_lai 於 2015-11-13 07:55 編輯

回復 c_c_lai
這網頁有點奇怪,年度的選項為何有下一年度(未來的年度).
有人可分享嗎?
GBKEE 發表於 2015-11-13 06:00

下一年度(未來的年度) 民國 105 年尚未到達，理論上它是一個未知數，
會計年度也只到今年度而已，且尚未年度結轉哪來的資料？
[attach]22428[/attach]

作者: chang0833 時間: 2015-11-14 14:03

版大，可以在請教一下關於這個財報網頁下載下來的資料問題嗎？
我用vlookup 來比對資料，卻發現下列資料有重複，vlookup 只能捉到第一筆資料，
但是第一筆資料是空白的，要如何捉到重複資料但又可以選擇其後有資料的欄位捉取
再麻煩版大賜教了^^

   應收票據淨額
   應收票據淨額 72,036
   應收帳款淨額
   應收帳款淨額 19,452,028
   應收帳款－關係人淨額
   應收帳款－關係人淨額 231,367

作者: c_c_lai 時間: 2015-11-15 07:01

本帖最後由 c_c_lai 於 2015-11-15 07:04 編輯

回復 34# chang0833
第一個『應收票據淨額』是『項目』(標題)，
第二個『應收票據淨額』是會計『科目』，
兩者在寶表上是有前後位置差異的，
轉入後如不仔細觀察，便以為是
重覆『科目』了。
至於 VLOOKUP 的應用就有勞 GBKEE 版大了。

作者: GBKEE 時間: 2015-11-15 07:32

本帖最後由 GBKEE 於 2015-11-16 05:28 編輯

回復 34# chang0833
或是附檔需要哪些資料

Next
'''加上這段試試看
With Rng.Parent
.Range("A:A").SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
'刪除:工作表上的空白列
End With
''''''''''''''''
MsgBox "Ok"

複製代碼

作者: chang0833 時間: 2015-11-15 10:38

回復 35# c_c_lai
感謝大大的回復，我懂了，原來差異就在前面空格的排列順序了，不仔細看真的看不出來^^
另外感謝GBKEE版大的用心回復謝謝^^

作者: chang0833 時間: 2015-11-15 14:02

回復 36# GBKEE
版大，我將你的程式，改成各季財報橫放，但要如何複製各季財報到其他工作頁時，可以"指定"儲存格存放
比如第一季財報複製其他工作表到a到d欄，第二季複製到g欄到j欄存放    -----( 採固定4欄的格式存放)
我本來想說用IF跑迴圈的程式如讀取到第一列有"會計項目"時，則選取第1到第4欄複製到其它工作表的指定位置
讀取到第二個"會計項目"時，複製到下的個指定的工作表上...
不過對新手的我來說還是很難做到，再煩請版大賜教了，謝謝^^

Dim URL As String, xCo_Id As String, x As Integer, Rng As Range
Dim E As Variant, xSyear As Integer, xSseason As Integer, D_Name As String
Dim Ia As Integer
With ActiveSheet
      For Each E In .QueryTables 'WEB查詢物件集合
         E.Delete
      Next
      For Each E In .Names    'Name 物件的集合
         .Names(E.Name).Delete
      Next
      .UsedRange.Clear
      Set Rng = .Range("a1") '指定工作表上 WEB查詢的位置
End With
xCo_Id = Application.InputBox("請輸入股票代號", , 2303)       '預設為 2303
x = Year(Date) - 1910                '中華民國的年度
For xSyear = x To x - 3 Step -1       '迴圈:年度 '105->102
'For xSyear = X - 3 To X             '迴圈:年度 '102->105
      For xSseason = 4 To 1 Step -1 '          '迴圈:季別 '1,2,3,4
         URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
         With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Rng)
            .Name = xCo_Id & "_" & xSyear & "_第" & xSseason & "季" 'WEB查詢的名稱
            .AdjustColumnWidth = True                '自動調整欄寬
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "2,3,4"                '資產負債表,綜合損益表,現金流量表
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
            If .ResultRange.Rows.Count = 2 Then '無資料
                  D_Name = .Name                'WEB查詢的名稱
                  .Delete                      '刪除:WEB查詢
                  With Rng.Parent
                     For Each E In .Names
                        If InStr(E.Name, D_Name) Then E.Delete '刪除:工作表上的名稱->WEB查詢的名稱
                     Next
                  End With
            Else
                  With .ResultRange    'WEB查詢資料的範圍
                     Set Rng = .Cells(1, .Columns.Count + 2) '下一WEB查詢的位置
                  End With
            End If
         End With
      Next
Next

Dim Ba As Integer                               '因讀取到還未發佈的財報，會留空白欄
                                             '判斷前50欄是否有空白欄，有則刪除
For Ba = 1 To 50
If Range("A" & Ba).Value = "" Then
   Selection.EntireColumn.Delete
   Else
End If
Next

End Sub

作者: GBKEE 時間: 2015-11-16 07:34

回復 38# chang0833
試試看

Option Explicit
Sub Ex()
Dim URL As String, xCo_Id As String, X As Integer
Dim xSyear As Integer, xSseason As Integer, Ar(1 To 4)
Dim Sh(1 To 2) As Worksheet, AY, Rng As Range, E As Variant
Dim Wb As Workbook
For X = 0 To 3
Ar(X + 1) = 1 + (6 * X) '第一季到第四季的欄位
Next
xCo_Id = Application.InputBox("請輸入股票代號", , 2303) '預設為 2303
X = Year(Date) - 1910 '中華民國的年度
Application.ScreenUpdating = False
Set Wb = Workbooks("book1.xls") '指定活頁簿
With Wb
Set Sh(1) = .Sheets.Add '新增工作表: 複製季財報到指定工作頁
Set Sh(2) = .Sheets.Add '新增工作表: WEB查詢用
End With
On Error GoTo Er '處理程式上的錯誤
Sh(1).Name = xCo_Id & "季報表" '這名稱工作表如已存在程式會有錯誤
On Error GoTo 0 '不在處理程式上的錯誤
For xSyear = X To X - 3 Step -1 '迴圈:年度 '105->102
'For xSyear = X - 3 To X '迴圈:年度 '102->105
For xSseason = 1 To 4 ' '迴圈:季別 '1,2,3,4
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With Sh(2).QueryTables.Add(Connection:=URL, Destination:=Sh(2).[A1])
.Name = xCo_Id & "_" & xSyear & "_第" & xSseason & "季" 'WEB查詢的名稱
.AdjustColumnWidth = True '自動調整欄寬
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,3,4" '資產負債表,綜合損益表,現金流量表
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
If .ResultRange.Rows.Count > 2 Then '有資料
Set Rng = Sh(1).Cells(1, Ar(xSseason)).Cells(Rows.Count).End(xlUp)
If Rng.Row > 1 Then Set Rng = Rng.Offset(2)
.ResultRange.Copy Rng
Else
.Delete
End If
End With
Next
Next
Application.DisplayAlerts = False
Sh(2).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Sh(1).Parent.Save
MsgBox "Ok"
Exit Sub
Er: '處理 xCo_Id &季報表工作表已存在
Application.DisplayAlerts = False
Sheets(xCo_Id & "季報表").Delete
Application.DisplayAlerts = True
Resume Next '回到錯誤的程式碼
End Sub

複製代碼

作者: chang0833 時間: 2015-11-16 22:32

回復 39# GBKEE

感謝版大的熱心回復^^
版大這次寫的程式，對新手的我有點....困難
我試著跑程式....但跑出"陣列索引超出範圍"...這是什麼情形

作者: GBKEE 時間: 2015-11-17 07:02

回復 40# chang0833

Option Explicit
Sub Ex()
Dim Wb As Workbook
Set Wb = ActiveWorkbook '作用中活頁簿
Set Wb = ThisWorkbook '程式碼所在的活頁簿
Set Wb = Workbooks("book1") '已開啟了的活頁簿中,指定的活頁簿
Set Wb = Workbooks.Open("D:\試算表\Book1.xls") '要開啟的活頁簿
Set Wb = Workbooks("Book1.xls") '已開啟了的活頁簿中,指定的活頁簿
End Sub

複製代碼

[attach]22461[/attach]

作者: chang0833 時間: 2015-11-17 23:48

感謝版大的教學，這部分我懂了^^
另外，再請教版大一些問題，希望版大不要覺得煩，有點良心過意不去~~
1.版大程式中有一個工作頁如果出現同名的解決方式，
可以把它換成同名就覆蓋原工作頁嗎？(只留下最後更新的資料)
2.執行程式時，工作頁會隨著每執行一次就一直增加，該如何清除？
3.在程式中，會把最新一年的四季下載完後，會往下面的"列"表在執行第二
二年的下載，資料會在下面的"列"存放，可以都把它們全放在第一列嗎？
4.因為改第3項問題時，季別會照(105)1.2.3.4.(104年)1.2.3.4季別存放，可以
從第一欄開始就直接放最新的季別嗎(例：像現在是第3季，就以第3季放在開頭
麻煩版大解惑了，謝謝^^

作者: GBKEE 時間: 2015-11-18 08:04

回復 42# chang0833
是這樣嗎?

Option Explicit
Sub Ex()
Dim URL As String, xCo_Id As String
Dim xSyear As Integer, xSseason As Integer
Dim Sh(1 To 2) As Worksheet, Rng As Range
xCo_Id = Application.InputBox("請輸入股票代號", , 2303) '預設為 2303
xSyear = Format(Date, "E") '中華民國的年度
xSseason = DatePart("q", Date) '當季
Application.ScreenUpdating = False
'Set Wb = ThisWorkbook '指定活頁簿
With ThisWorkbook '指定活頁簿
Set Sh(1) = .Sheets.Add '新增工作表: 複製季財報到指定工作頁
Set Sh(2) = .Sheets.Add '新增工作表: WEB查詢用
End With
On Error GoTo Er '處理程式上的錯誤
Application.DisplayAlerts = False
Sh(1).Name = xCo_Id & "季報表" '這名稱工作表如已存在程式會有錯誤
Set Rng = Sh(1).[A1]
On Error GoTo 0 '不再處理程式上的錯誤
Do
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With Sh(2).QueryTables.Add(Connection:=URL, Destination:=Sh(2).[A1])
.Name = xCo_Id & "_" & xSyear & "_第" & xSseason & "季" 'WEB查詢的名稱
.AdjustColumnWidth = True '自動調整欄寬
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,3,4" '資產負債表,綜合損益表,現金流量表
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
If .ResultRange.Rows.Count > 2 Then '有資料
Debug.Print xSyear, xSseason, Rng.Address
.ResultRange.Copy Rng
Set Rng = Rng.Offset(, .ResultRange.Columns.Count + 1)
Else
.Delete
End If
End With
xSseason = xSseason - 1
If xSseason = 0 Then
xSseason = 4
xSyear = xSyear - 1
End If
Loop Until xSyear = Format(Date, "E") - 3
Sh(2).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
' Sh(1).Parent.Save
MsgBox "Ok"
Exit Sub
Er: '處理 xCo_Id &季報表工作表已存在
Sheets(xCo_Id & "季報表").Delete '覆蓋原工作頁嗎？(只留下最後更新的資料)
Resume '回到錯誤的程式碼
End Sub

複製代碼

作者: chang0833 時間: 2015-11-18 22:58

回復 43# GBKEE

太感謝版大了^^
就是這樣，其中我想以著程式做一些小修改(自己努力看看)，如果改不出來，再麻煩版大指導了，感恩^^

作者: yarchen 時間: 2016-6-6 00:02

感謝版大您的分享, 我已用 VBA 寫程式抓取公開資訊觀測站許多資料存入 ACCESS DB 然後再做分析處理, 也是這方面有些經驗的愛好者, 包含處理 SEND GET, POST 和 Request COOKIES 等等 ,
有一問題冒昧請教, 公開資訊觀測站單位時間內有訪問次數限制(好像是每分鐘限制連續訪問網頁20次左右), 在大量抓取網頁資料時, 常有99%時間都在延遲等待, 我曾經想用更改 ip, 或是多線程平行處理來解決這個問題, 請教您是如何解決此一問題?? 感謝指點

作者: joey0415 時間: 2016-6-6 08:13

回復 45# yarchen

會檔就調慢一點，一分鐘十次也行

不然改用vba xmlhttp post 方法抓

下面這個連結，學會後自己就會修改

http://club.excelhome.net/thread-1159783-1-1.html

作者: jasonwu0114 時間: 2016-12-23 17:03

回復 8# GBKEE

請教G大
如果我在EXCEL表中列出一列20-30個股票代號
要查105第三季
""資產負債表""中的某一科目"ex 應付短期票券合計"的餘額放在股票代號旁邊

如何利用這隻程式來改??

作者: GBKEE 時間: 2016-12-24 08:29

本帖最後由 GBKEE 於 2016-12-24 09:07 編輯

回復 47# jasonwu0114
試試看

Option Explicit
Sub Ex()
Dim URL As String, xCo_Id As Range, xSyear As String, xSseason As String, i As Integer, M As Variant
xSyear = 105
xSseason = 3
For i = 1 To 20 '跑20-30個股票代號
Set xCo_Id = Sheets(1).Cells(i, "A") '股票代號
URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
With SheetS(2).QueryTables.Add(Connection:=URL, Destination:=Sheets(2).Range("A1"))
.AdjustColumnWidth = False '自動調整欄寬
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2" ',3,4" '資產負債表,綜合損益表,現金流量表
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
With .ResultRange '所匯入資料的範圍
M = Application.Match("*應付短期票券合計", .Columns(1), 0) '工作表函數在第一欄中傳回比對到的欄位
If IsNumeric(M) Then xCo_Id.Offset(, 1) = .Cells(M, "b") '有比對到傳回的欄位的數字
.Clear
End With
.Parent.Names(.Name).Delete '刪除工作表的名稱
.Delete ''這QueryTable刪除掉
End With
Next
End Sub

複製代碼

作者: jasonwu0114 時間: 2016-12-26 14:49

回復 48# GBKEE

OK太棒了
G大感恩
終於解決困擾我長久以來的問題
又學到好幾招

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