如何找出網站原始檔網址 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 如何找出網站原始檔網址

返回列表下一主題上一主題發帖

[發問] 如何找出網站原始檔網址

超級版主 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兔年全勤獎章

11^# 跳轉到 »

發表於 2014-1-26 18:02 | 顯示全部帖子

本帖最後由 GBKEE 於 2014-1-28 07:00 編輯

回復 31# pollllopkimo

Option Explicit
Sub 公開資訊網頁()
Dim A As Object, E As Object, Sh As Worksheet
Set Sh = Sheets("sheet1") '物件: 指定工作表
Sh.Activate
With CreateObject("InternetExplorer.Application")
'.Visible = True
' .Navigate "http://mops.twse.com.tw/mops/web/t164sb04" '網址:綜合損益表
.Navigate "http://mops.twse.com.tw/mops/web/stapap1" '網址:董監事持股餘額明細資
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 = Sh.Range("C1") '年度
'.document.getElementById("season").Value = "01" '綜合損益表:第1季(季別)
.document.getElementById("month").Value = Format(Sh.Range("D1"), "00") '董監事持股餘額明細資料:月份
End If
'********************************************************************
For Each A In .document.getelementSbyTAGNAME("INPUT")
If A.Name = "co_id" Then A.Value = Sh.Range("b1") '股票代號
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
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
With Sh
.UsedRange.Offset(4).Clear
.Range("B5").Select
.PasteSpecial Format:="HTML"
.Range("B5").Select
If .Shapes.Count > 0 Then '有圖片
.Shapes.SelectAll
Selection.Delete
End If
End With
End If
Next
.Quit '關閉 IE
End With
End Sub

複製代碼

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

超級版主 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兔年全勤獎章

12^#

發表於 2014-2-6 08:18 | 顯示全部帖子

回復 34# blue2263
按F8逐行執行是哪一個程序

'****** 附檔沒這工作表
With Sheets("巨集工作表")
Set Rng(1) = .Range("B2")
.Activate
End With
'Sheets("匯總").UsedRange.Offset(1).Clear '用此程式碼" 如需清除舊有資料
Do While Rng(1) <> ""
Rng(1).Activate
With Sheets("原始表")
.Range("B2") = Rng(1)
'**** .Range("E7") 沒有Web **********
.Range("E7").QueryTable.Refresh BackgroundQuery:=False

複製代碼

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

超級版主 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兔年全勤獎章

13^#

發表於 2014-2-6 13:44 | 顯示全部帖子

本帖最後由 GBKEE 於 2014-2-6 13:46 編輯

回復 36# blue2263

Sub Macro()
' 報表整合1-new
Dim Rng As Range
On Error GoTo 101 ' 'web 查無到下一個代碼
Set Rng = Sheets("代碼").[a2]
Do While Rng(1) <> "" '無代碼中斷
With Sheets("原始表")
.Range("a6") = Rng
.Range("az7").QueryTable.Refresh BackgroundQuery:=False
End With
With Sheets("匯總").Range("A1").End(xlDown).Offset(1) '選擇工作表,到最底行
.Range("A1:aw1").Value = Sheets("原始表").Range("A6:aw6").Value
End With
101
Set Rng = Rng.Offset(1) '下一個代碼
Loop
End Sub

複製代碼

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

超級版主 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兔年全勤獎章

14^#

發表於 2014-2-6 20:48 | 顯示全部帖子

本帖最後由 GBKEE 於 2014-2-6 20:55 編輯

回復 38# blue2263
內有很多函數,所以造成資料更新會變的很慢,應該不是如此.
是否活頁簿的計算是手動,要改成自動

下列程式碼,工作表可不用函數算.

Option Explicit
Sub Macro()
' 報表整合1-new
Dim Rng As Range, Ar(1 To 3)
On Error GoTo 101 ' 'web 查無到下一個代碼
Set Rng = Sheets("代碼").[a2]
Do While Rng <> "" '無代碼中斷
With Sheets("原始表")
.Range("a6") = Rng
.Range("az7").QueryTable.Refresh BackgroundQuery:=False
With .Range("BB12:BB27")
Ar(1) = Application.Transpose(.Cells) '人數
Ar(2) = Application.Transpose(.Offset(, 1)) '股數
Ar(3) = Application.Transpose(.Offset(, 2)) '佔集保庫存數比例 (%)
End With
End With
With Sheets("匯總").Range("A1").End(xlDown).Offset(1) '選擇工作表,到最底行
.Cells(1) = Rng
.Cells(1, 2) = Rng.Offset(, 1)
.Cells(1, "C").Resize(, UBound(Ar(1))) = Ar(1)
.Cells(1, "S").Resize(, UBound(Ar(1))) = Ar(2)
.Cells(1, "AI").Resize(, UBound(Ar(1))) = Ar(3)
.Cells(1, "AX") = ""
'.Range("A1:aw1").Value = Sheets("原始表").Range("A6:aw6").Value
End With
101
Set Rng = Rng.Offset(1) '下一個代碼
Loop
End Sub

複製代碼

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

超級版主 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兔年全勤獎章

15^#

發表於 2014-2-7 08:16 | 顯示全部帖子

回復 40# blue2263
直接讀取資料,比拐彎(函數計算)讀取資料當然是快的

在有刪工作表的檔案,用#39程式碼, 下載10個代碼,花了6秒,資料正確
在沒有刪工作表的檔案,用#39程式碼, 下載10個代碼,花了3分9秒,資料正確

在沒有刪工作表的檔案(函數太多),執行原來程式(程式執行迴圈一次,活頁簿的函數重算尚未完成)故得到資料不正確

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

靜思自在 : 犯錯出懺悔心，才能清淨無煩惱。

返回列表下一主題上一主題