snare wrote:
74樓?是71樓吧，(恕刪)
按照說明可以執行了，謝謝指導。
個人積分：89分
文章編號：75919579
個人積分：63分
文章編號：75955627
個人積分：3107分
文章編號：75959534
bioleon69 wrote:
以你VBA的功力,說真的出書實在綽綽有餘了
而且這一層樓也有許多範例可以套用..(恕刪)
如果是指“純vba”抓資料
已經有一些高手們，收集網路上的範例，融會貫通，轉成自己的知識
出版vba抓資料的書、做出付費線上教學
我很感謝，這些高手們大部份都有標示文章來源(包含這一棟樓)
當然，我po文時就有想過這些了，這是有市場的東西，總是會有人拿來賺錢
不過，能化為自己的知識賺錢，都是好事
只是少部份比較討厭，不是靠自己的知識賺錢
直接用別人的範例，稍微改一下就用
從文章、教學的po文日期、程式內容、出版日期，比對一下可知，都跟著高手們的範例走
有新範例，才有新教學
，只能說他們抓住另類賺錢的機會
(google 真是好用，什麼都找的到
)您要買就去買市面上的出版物、付費教學吧
您也可以直接用投資理財區那些高手開發的免費版、精簡版的程式、手機app
有需要再付費買完整版
個人積分：63分
文章編號：75971515
個人積分：3107分
文章編號：75972019
bioleon69 wrote:
真的假的...用這邊的東西然後出去收費?
有連結嗎(恕刪)
連結? 就免了
我只是討厭那些“完整引用”，卻沒有標示來源
反而我很欣賞那些能自己理解後，做出程式、教學、出版物的人
而且這是公開文章，技術交流用的
所有的知識、技術，都是先從模仿、學習而來的
vba我也是參考各種文章才學會的
我的文章第一篇是2016年，那時市面上還沒有“純vba“抓資料的書可買
(Python + vba，或是Python，印像中好像有幾本可買?)
論譠文章，基本上都是 ie object 、query table，這種慢速的方法為主
真想賺錢，我自己來就好了，何必公開
我不介意賺錢這件事，學以致用，本來就是一件好事
舉例來說，
一個畫家，教2個學生，畫家同意學生模仿他的作品拿去賣錢
其中一個學生花很長的時間努力學畫，最終達到畫家的水準，拿去賣錢
另一個學生直接把作品影印，拿去賣錢，但畫畫的技能一樣爛
一個學生出師了，永遠有新創作，另一個學生，永遠只能等別人的新作品
賺錢的結果是一樣的，只是過程不同，沒什麼對錯
現在不像以前，只要努力就一定有好結果
就像拚命加班的員工只是公司的“零件”，肝壞了雖時都可以換掉
也許不小心路過彩券行，花50元買一張大樂透，從此變人生勝利組也說不定
最近比較有名努力沒有好結果的慘事，北韓跑者「跟錯車」痛失冠軍
https://sports.ltn.com.tw/news/breakingnews/3017635
感想，人生充滿了意外啊，其它國家就算了，北韓，回國之後不知道會怎麼樣
就像玩股票一樣，我可以努力的學分析自己選股，賺錢永遠快人家一步
也可以直接拿別人的分析來選股啊，但賺錢永遠慢人家一步
總而言之，最後抓住機會的人，才是贏家
個人積分：89分
文章編號：76060234
程式中有兩行
url = "https://goodinfo.tw/StockInfo/StockFinDetail.asp?RPT_CAT=BS_M_QUAR&STOCK_ID=2412"
url_a = "https://goodinfo.tw/StockInfo/StockFinDetail.asp?STEP=DATA&STOCK_ID=2412&RPT_CAT=BS_M_YEAR&QRY_TIME=20184"
相信應該是取得GoodInfo的資料取得連結，其中url變數的意義可以理解，看到url_a的部分所代表連結是什麼呢??為何需要兩個連結，這樣的變數設計的原意是?還請樓主不吝賜教。謝謝。
個人積分：3107分
文章編號：76064839
lpviva wrote:
請問樓主一個有關於#613樓的問題
程式中有兩行
url = "https://goodinfo.tw/StockInfo/StockFinDetail.asp?RPT_CAT=BS_M_QUAR&STOCK_ID=2412"
url_a = "https://goodinfo.tw/StockInfo/StockFinDetail.asp?STEP=DATA&STOCK_ID=2412&RPT_CAT=BS_M_YEAR&QRY_TIME=20184"
...(恕刪)
這是Sub get_Q_Y() 副程式中用的
第一個網址 url ，取得季別下拉式選單內所有的資料
第二個網址 url_a，取得年度下拉式選單內所有的資料
lpviva wrote:
相信應該是取得GoodInfo的資料取得連結，其中url變數的意義可以理解，看到url_a的部分所代表連結是什麼呢??為何需要兩個連結，這樣的變數設計的原意是?...(恕刪)
進入GoodInfo網站後
預設會先開季別的下拉式選單
所以 get_Q_Y()副程式，用迴圈跑2次
第1次url先拿季別，第2次url_a拿年度
至於選中華電2412、日期20184，沒什麼特別意義，隨便選的
目地只是要選單內的資料，做成excel中的下拉式選單
算是一個簡單防呆的設計，避免輸入錯誤，順便檢查網站是否正常用的
您不想用 get_Q_Y() 副程式，要改成定值、inputbox…也可以
個人積分：89分
文章編號：76074125
個人積分：3107分
文章編號：76078960
lpviva wrote:
如果是要取得XLS檔，是不是可以設計跑第三個迴圈? 設定另一個變數如url_b來觸動點選xls按鈕來下載xls檔?謝謝。(恕刪)
這個我在291樓有解釋過了，xls、html按鈕，按下去後的下載網址，是blob格式
blob:https://goodinfo.tw/xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx
後面那串xxxxx是隨機號碼
2個按鈕，下載的東西是一模一樣的，就是您開網頁後存在電腦的暫存檔
差別只在一個存檔xls、另一個存html
所以沒必要去為了點那個按鈕做多次查詢，反而會讓程式變慢
請直接用excel本身的另存新檔功能就好
或是用vba另存指定的工作表(如果改成迴圈，就可把大量工作表，一次分開另存新檔)
Sub save_sheet()
Dim wb As Workbook
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
ThisWorkbook.Worksheets("工作表2").Copy After:=.Worksheets(.Worksheets.Count)
'要存檔的工作表名稱
Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
.SaveAs "c:\excel\temp.xlsx"
'存檔路徑+檔名
.Close False
End With
End Sub
個人積分：89分
文章編號：76099014
snare wrote:
這個我在291樓有解(恕刪)
謝謝snare兄指導，感覺上又懂得多了一點。
想要下載goodinfo的融資餘額，以snare兄的程式為本作部分修改，將兩份報表並排比較的改成單一報表，改完程式後有幾個問題。
程式執行完下載單一報表完成如圖，但箭頭所指的下拉選單已經用不著，想刪掉但程式中不知在何處修改。
之後僅將原先URL指定的下載goodinfo報表位置修改為下載融資餘額的位置，但執行完後沒有資料載入如圖。
修改後程式如最後所附，不知哪裡需要調整，還請snare兄指點，謝謝。
goodinfo融資餘額下載連結位置:
原先snare兄的下載改成單一報表，下載成功畫面，但不知如何刪除下拉選單框。
修改程式URL位置指向goodinfo融資餘額處，執行程式後結果畫面，無資料載入。
goodinfo融資餘額下載畫面，下載時選單中的"排名範圍選擇"希望由原來的指定300檔，自動修改為"全部顯示"
修改後程式:
Private Sub CommandButton1_Click()
On Error Resume Next
With Sheets("工作表1")
.Select
.Cells.Clear
.Cells(2, 3) = "融資餘額"
.OLEObjects("CommandButton1").Object.Caption = "按我下載融資餘額"
Call getgoodinfo
End With
End Sub
Sub getgoodinfo()
ttt = Timer
Dim HTMLsourcecode, Table, Clipboard As Object, StockID As String, URL As String, URL_a As String
Set HTMLsourcecode = CreateObject("htmlfile")
Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
StockID = Sheets("工作表1").Cells(3, 3)
'URL = "https://goodinfo.tw/StockInfo/StockCashFlow.asp?STOCK_ID=2886" & "&RPT_CAT=" & Report2
URL = "https://goodinfo.tw/StockInfo/StockList.asp?MARKET_CAT=熱門排行&INDUSTRY_CAT=融資餘額&SHEET=融資融券&SHEET2=資券增減統計&RPT_TIME="
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", URL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send
HTMLsourcecode.body.innerhtml = convertraw(.ResponseBody)
Set Table = HTMLsourcecode.getelementbyid("txtFinDetailData")
'If Table.innertext = "查無資料" Then
' Sheets("工作表1").Cells(2, 3) = "查無資料"
' Exit Sub
'End If
With Clipboard
.SetText Table.innerhtml
.PutInClipboard
End With
With Sheets("工作表1")
.Select
.Cells.Clear
.Cells(1, 1).Select
.PasteSpecial NoHTMLFormatting:=True
.Columns.AutoFit
.Cells(1, 1) = Split(HTMLsourcecode.all.tags("table")(13).innertext, " ")(1)
.Cells(2, 1).Select
MsgBox .Cells(1, 1) & "下載時間" & Round(Timer - ttt, 2) & "秒", vbOKOnly, "Report"
End With
End With
'Call DelTitle
Set HTMLsourcecode = Nothing
Set Table = Nothing
Set Clipboard = Nothing
End Sub
Function convertraw(rawdata)
Dim rawstr
Set rawstr = CreateObject("adodb.stream")
With rawstr
.Type = 1
.Mode = 3
.Open
.Write rawdata
.Position = 0
.Type = 2
.Charset = "utf-8"
convertraw = .ReadText
.Close
End With
Set rawstr = Nothing
End Function
'Sub AddListBox()
' With Sheets("工作表1")
' Set list_0 = .ListBoxes.Add(.Range("b7").Left + 5, .Range("b7").Top, 100, 100)
' With list_0
' .Name = "list_0"
' list_0.List = Array("合併季報" & Space(30) & ",M_QUAR", "合併累計季報" & Space(30) & ",M_QUAR_ACC", "合併年報" & Space(30) & ",M_YEAR", "非合併季報" & Space(30) & ",QUAR", "非合併累計季報" & Space(30) & ",QUAR_ACC", "非合併年報" & Space(30) & ",YEAR")
' .Selected(1) = True
' End With
' End With
'End Sub
Sub DelTitle()
With Sheets("工作表1")
For i = .Range("a1").CurrentRegion.Rows.Count To 6 Step -1
If .Cells(i, 1) = "年度" Or .Cells(i, 1) = "季度" Then
.Rows(i & ":" & i + 3).Delete Shift:=xlUp
End If
Next i
.Cells(2, 1).Select
End With
End Sub
