12345
返回列表 上一主題 發帖

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

pollllopkimo

帖子
3 
主題
0 
精華
0 
積分
4 
點名
0  
作業系統
xp 
軟體版本
2003 
閱讀權限
10 
註冊時間
2014-1-25 
最後登錄
2014-1-29 

論壇贊助勳章
31# 跳轉到 »
發表於 2014-1-26 15:14 | 只看該作者
回復 30# GBKEE


請參考附件
麻煩G大了  謝謝

發問.rar (12.17 KB)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
32#
發表於 2014-1-26 18:02 | 只看該作者
本帖最後由 GBKEE 於 2014-1-28 07:00 編輯

回復 31# pollllopkimo
  1. Option Explicit
  2. Sub 公開資訊網頁()
  3.     Dim A As Object, E As Object, Sh As Worksheet
  4.     Set Sh = Sheets("sheet1")  '物件: 指定工作表
  5.     Sh.Activate
  6.     With CreateObject("InternetExplorer.Application")
  7.         '.Visible = True
  8.         ' .Navigate "http://mops.twse.com.tw/mops/web/t164sb04"     '網址:綜合損益表
  9.         .Navigate "http://mops.twse.com.tw/mops/web/stapap1"        '網址:董監事持股餘額明細資
  10.         Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
  11.             .document.getElementById("isnew").Value = "false"       '選擇: 歷史資料
  12.             '註解上一行程式碼為 -> 選擇: 最新資料,不會執行 If 內程式碼
  13.            
  14.             If .document.getElementById("isnew").Value = "false" Then
  15.              .document.getElementById("isnew").FireEvent ("onchange")
  16.                 .document.getElementById("year").Value = Sh.Range("C1")       '年度
  17.                 '.document.getElementById("season").Value = "01"    '綜合損益表:第1季(季別)
  18.                 .document.getElementById("month").Value = Format(Sh.Range("D1"), "00")    '董監事持股餘額明細資料:月份
  19.             End If
  20.             '********************************************************************
  21.            For Each A In .document.getelementSbyTAGNAME("INPUT")
  22.            
  23.                 If A.Name = "co_id" Then A.Value = Sh.Range("b1")       '股票代號
  24.                
  25.                
  26.                 If A.Value = " 搜尋 " Then A.Click                     '按下 搜尋
  27.             Next
  28.             Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
  29.             For Each E In .document.ALL.TAGS("div")
  30.                 If E.ID = "table01" Then
  31.                     .document.body.innerHTML = E.outerHTML
  32.                     .ExecWB 17, 2       '  Select All
  33.                     .ExecWB 12, 2       '  Copy selection
  34.                     Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
  35.                     With Sh
  36.                         .UsedRange.Offset(4).Clear
  37.                         .Range("B5").Select
  38.                         .PasteSpecial Format:="HTML"
  39.                         .Range("B5").Select
  40.                         If .Shapes.Count > 0 Then  '有圖片
  41.                             .Shapes.SelectAll
  42.                             Selection.Delete
  43.                         End If
  44.                     End With
  45.                 End If
  46.             Next
  47.         .Quit                          '關閉 IE
  48.     End With
  49. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

pollllopkimo

帖子
3 
主題
0 
精華
0 
積分
4 
點名
0  
作業系統
xp 
軟體版本
2003 
閱讀權限
10 
註冊時間
2014-1-25 
最後登錄
2014-1-29 

論壇贊助勳章
33#
發表於 2014-1-26 20:40 | 只看該作者
[版主管理留言]
  • GBKEE(2014/2/6 08:02): 32#的程式碼已更新

回復 32# GBKEE


先謝謝g大
目前發現一個問題例如當抓股票代號2886時候
會把網頁上的圖片 圖片.JPG 也一併抓下來
再抓第二次時候該圖片會殘留
有辦法抓第二次時刪除或是第一次只抓文字,表格嘛?
再次麻煩g大  謝謝

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2025-5-26 
34#
發表於 2014-2-5 22:50 | 只看該作者
G大你好,之前程式,為了需求,做了一些修改,有些問題,想請G大麻煩幫我看一下
1.程式會無法自動執行,會中斷?
2.按F8逐行執行沒有問題,但發現執行下載後的資料與原始資料不同?

檔A.rar (74.39 KB)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
35#
發表於 2014-2-6 08:18 | 只看該作者
回復 34# blue2263
按F8逐行執行是哪一個程序
  1.   '****** 附檔沒這工作表
  2.     With Sheets("巨集工作表")
  3.         Set Rng(1) = .Range("B2")
  4.         .Activate
  5.     End With
  6.     'Sheets("匯總").UsedRange.Offset(1).Clear   '用此程式碼" 如需清除舊有資料
  7.     Do While Rng(1) <> ""
  8.         Rng(1).Activate
  9.         With Sheets("原始表")
  10.             .Range("B2") = Rng(1)
  11.             '****  .Range("E7") 沒有Web  **********
  12.             .Range("E7").QueryTable.Refresh BackgroundQuery:=False
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2025-5-26 
36#
發表於 2014-2-6 12:22 | 只看該作者
G大,不好意思我指的問題程序是,報表整合1-new
程式會中斷及按F8執行,下載資料拿錯誤,都是此程序
謝謝G大

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
37#
發表於 2014-2-6 13:44 | 只看該作者
本帖最後由 GBKEE 於 2014-2-6 13:46 編輯

回復 36# blue2263
  1. Sub Macro()
  2.     ' 報表整合1-new
  3.     Dim Rng As Range
  4.     On Error GoTo 101 '   'web 查無 到下一個代碼
  5.     Set Rng = Sheets("代碼").[a2]
  6.     Do While Rng(1) <> ""   '無代碼 中斷
  7.         With Sheets("原始表")
  8.             .Range("a6") = Rng
  9.             .Range("az7").QueryTable.Refresh BackgroundQuery:=False
  10.         End With
  11.         With Sheets("匯總").Range("A1").End(xlDown).Offset(1) '選擇工作表,到最底行
  12.                 .Range("A1:aw1").Value = Sheets("原始表").Range("A6:aw6").Value
  13.             End With
  14. 101
  15.          Set Rng = Rng.Offset(1)   '下一個代碼
  16.     Loop
  17. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2025-5-26 
38#
發表於 2014-2-6 19:03 | 只看該作者
感謝G大熱心幫忙,問題1,己可正常執行了
另請教G大,因我這個檔案,內有很多函數,所以造成資料更新會變的很慢
所以執行巨集時會造成資料錯誤,如下圖
請教G大是否有程式碼,可解決此問題,還是只能將檔案分開為兩個(下載資料用,及分析用)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
39#
發表於 2014-2-6 20:48 | 只看該作者
本帖最後由 GBKEE 於 2014-2-6 20:55 編輯

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



下列程式碼,工作表可不用函數算.
  1. Option Explicit
  2. Sub Macro()
  3.     ' 報表整合1-new
  4.     Dim Rng As Range, Ar(1 To 3)
  5.     On Error GoTo 101 '   'web 查無 到下一個代碼
  6.     Set Rng = Sheets("代碼").[a2]
  7.     Do While Rng <> ""   '無代碼 中斷
  8.         With Sheets("原始表")
  9.             .Range("a6") = Rng
  10.             .Range("az7").QueryTable.Refresh BackgroundQuery:=False
  11.             With .Range("BB12:BB27")
  12.                 Ar(1) = Application.Transpose(.Cells)         '人數
  13.                 Ar(2) = Application.Transpose(.Offset(, 1))   '股數
  14.                 Ar(3) = Application.Transpose(.Offset(, 2))   '佔集保庫存數比例 (%)
  15.             End With
  16.         End With
  17.         With Sheets("匯總").Range("A1").End(xlDown).Offset(1) '選擇工作表,到最底行
  18.              .Cells(1) = Rng
  19.              .Cells(1, 2) = Rng.Offset(, 1)
  20.              .Cells(1, "C").Resize(, UBound(Ar(1))) = Ar(1)
  21.              .Cells(1, "S").Resize(, UBound(Ar(1))) = Ar(2)
  22.              .Cells(1, "AI").Resize(, UBound(Ar(1))) = Ar(3)
  23.              .Cells(1, "AX") = ""
  24.             '.Range("A1:aw1").Value = Sheets("原始表").Range("A6:aw6").Value
  25.        End With
  26. 101
  27.          Set Rng = Rng.Offset(1)   '下一個代碼
  28.     Loop
  29. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2025-5-26 
40#
發表於 2014-2-7 07:59 | 只看該作者
謝謝G大幫忙
回覆G大,我的設定是自動的沒錯,
用#39程式碼下載資料內容就正確了
我提供的檔案,有刪掉一些有函數工作表,所以跑起來會很慢
我做了一些測試
在有刪工作表的檔案,用#39程式碼, 下載10個代碼,花了6秒,資料正確
在沒有刪工作表的檔案,用#39程式碼, 下載10個代碼,花了3分9秒,資料正確
在沒有刪工作表的檔案,用#36程式碼,下載10個代碼,花了1分30秒,資料左天測試,是錯誤的(#38情形),今天又測試一次,資料又變回正確了??不知道是什麼問題?
請教G大,理論上是否用#39方法,資料上較不會有問題,
為了下載資料的速度,盡量檔案內也不要太多函數

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
12345
返回列表 上一主題