輸入股票代號,資料內容顯示於已編輯的表格內

　暱稱: 小B

帖子: 62
主題: 14
精華: 0
積分: 86
點名: 0
作業系統: win10
軟體版本: offffice2013
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2016-8-23
最後登錄: 2017-11-5

論壇贊助勳章

10^#

發表於 2016-9-9 21:50 | 只看該作者

好的,感謝GBK大
目前測試OK!也把巨集複製進去了!!
需要花點時間研究~程式碼忽然爆炸性成長了哈
謝謝~~~~這個網抓程式碼確實好用!!
強!

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

9^#

發表於 2016-9-9 14:28 | 只看該作者

回復 8# bioleon69
試試看

Option Explicit
Private Sub CommandButton1_Click()
Dim strURL$ '宣告strURL為變數
strURL = "https://tw.stock.yahoo.com/d/s/dividend_" & [A1].Value & ".html" '定義strURL變數內容
[A3].CurrentRegion = "" '清除文字沒清除格式(美化好的表格)
With ActiveSheet.QueryTables.Add("url;" & strURL, Range("a3"))
.WebFormatting = xlWebFormattingNone '(NONE)不包含格式,(ALL)包含格式
.WebSelectionType = xlSpecifiedTables '指定table表格模式
.WebTables = "8" '第8個table表格
On Error Resume Next
.Refresh False
[B1] = ""
If Err <> 0 Then
[B1] = "請輸入正確股票代號"
Else
'**********************************
'"欄寬"是否可以實現如同文字顏色背景一樣,能夠自適應?
'請錄製巨集後套用程式碼在此
'*****************************'
[B1] = 網頁(strURL) '填上股票名稱代號
End If
End With
End Sub
Private Function 網頁(Surl As String) As String
Dim oXmlhttp As Object, oHtmldoc As Object
Set oXmlhttp = CreateObject("msxml2.xmlhttp")
Set oHtmldoc = CreateObject("htmlfile")
With oXmlhttp
.Open "Get", Surl, False
.Send
oHtmldoc.write .responseText
End With
網頁 = Split(oHtmldoc.Title, "-")(0)
End Function

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

　暱稱: 小B

帖子: 62
主題: 14
精華: 0
積分: 86
點名: 0
作業系統: win10
軟體版本: offffice2013
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2016-8-23
最後登錄: 2017-11-5

論壇贊助勳章

8^#

發表於 2016-9-8 00:56 | 只看該作者

ex2.rar (20.09 KB)

附上檔案~~~~~

再次感謝大大!!!

　暱稱: 小B

帖子: 62
主題: 14
精華: 0
積分: 86
點名: 0
作業系統: win10
軟體版本: offffice2013
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2016-8-23
最後登錄: 2017-11-5

論壇贊助勳章

7^#

發表於 2016-9-8 00:51 | 只看該作者

GBK大~~我又來了阿!!哈哈
已經開始在研究您的程式碼了~!!

目前又遇到2個小問題

@
A3資料呈現確實可以編輯表格內文字顏色背景等等的!這邊是OK!
但是"欄寬"部分會跑回去
"欄寬"是否可以實現如同文字顏色背景一樣,能夠自適應?
@
在查詢失敗,B1會顯示"請輸入正確股票代號"
這部分完美!可使用!!正常運作!!
那反之,如果查詢成功了,B1格內就會"空白"
所以我想說
是否可以實現查詢成功,"B1"就顯示所輸入的股價代號以及名稱?

感謝GBK大大~~您辛苦了~~~~!!!!

　暱稱: 小B

帖子: 62
主題: 14
精華: 0
積分: 86
點名: 0
作業系統: win10
軟體版本: offffice2013
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2016-8-23
最後登錄: 2017-11-5

論壇贊助勳章

6^#

發表於 2016-9-7 17:46 | 只看該作者

完全可以使用!!
GB版大非常的感謝您
真的很厲害!
回家後會好好研究您目前的函數
把它好好學起來!!

會再度來打擾您的!!哈哈!!!
祝一切順心身體健康財源滾滾~~

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2016-9-6 14:49 | 只看該作者

回復 4# bioleon69

試試看

Option Explicit
Private Sub CommandButton1_Click()
Dim strURL$ '宣告strURL為變數
strURL = "https://tw.stock.yahoo.com/d/s/dividend_" & [A1].Value & ".html" '定義strURL變數內容
[A3].CurrentRegion = "" '清除文字沒清除格式(美化好的表格)
With ActiveSheet.QueryTables.Add("url;" & strURL, Range("a3"))
.WebFormatting = xlWebFormattingNone '(NONE)不包含格式,(ALL)包含格式
.WebSelectionType = xlSpecifiedTables '指定table表格模式
.WebTables = "8" '第8個table表格
On Error Resume Next
.Refresh False
If Err <> 0 Then
[B1] = "請輸入正確股票代號"
Else
[B1] = ""
End If
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

　暱稱: 小B

帖子: 62
主題: 14
精華: 0
積分: 86
點名: 0
作業系統: win10
軟體版本: offffice2013
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2016-8-23
最後登錄: 2017-11-5

論壇贊助勳章

4^#

發表於 2016-9-5 16:53 | 只看該作者

EX1.rar (17.5 KB)

菜鳥我已經簡單的把表格內著色
還有用了簡單框線以及字型
主要是希望打入股票代號後
A3所呈現的資料格式是依照我以上所編輯的表格內格式

問題：
▲
讓A3輸出的資料在我美化好的表格內

▲
A1輸入不是正確的股票代號時,或者空格沒輸入
能否在B1顯示"請輸入正確股票代號"

請求各路大俠幫助!!!