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

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

1^# 跳轉到 »

發表於 2016-9-5 13:20 | 顯示全部帖子

回復 3# bioleon69

▲我需要編輯,想要自行設計一個表格格式,附檔沒有你自行設計一個表格.
讓A3輸出的資料在我編輯好的表格格式內,你要如何編輯附檔沒有說明.

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

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

2^#

發表於 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元的贊助,人人有能力.

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

3^#

發表於 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元的贊助,人人有能力.