返回列表 上一主題 發帖

[發問] 請問這可設定等幾秒沒開網頁或網頁錯誤就執行下一筆嗎，謝謝

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2013-9-19 08:27 | 顯示全部帖子
回復 6# wufonna
試試看
  1. Option Explicit
  2. Dim ie As Object   '模組最頂端 Dim 供這模組的程序使用的變數
  3. Sub AllFile()
  4.     Dim i As Integer, v, Y As Integer, S As String
  5.     S = "I"                                                 '2005 年度起始欄位
  6.     Set ie = CreateObject("internetexplorer.application")   '使用此方式可以免除 "設定引用項目"
  7.     With ie '縮小IE視窗
  8.         .Visible = True
  9.         .Width = 5
  10.         .Height = 5
  11.     End With
  12.     With 工作表1

  14.         .Range(S & 1).CurrentRegion = ""            '清除工作表1,年度範圍
  15.         Do
  16.             .Range(S & 1).Offset(, Y) = 2005 + Y
  17.             Y = Y + 1
  18.         Loop While 2005 + Y < Year(Date)
  19.         For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
  20.             v = .Cells(i, 1).Value
  21.             GetDividend (v)
  22.             .Cells(i, S).Resize(, Y) = Application.WorksheetFunction.Transpose(工作表2.Range("H4").Resize(Y))
  23.             If Application.Sum(.Cells(i, S).Resize(, Y)) > 1 Then
  24.                 .Cells(i, S).Offset(, Y) = 1
  25.             Else
  26.                 .Cells(i, S).Offset(, Y) = 0
  27.             End If
  28.         Next
  29.         .Range(S & 1).CurrentRegion.Replace "--", "", xlWhole
  30.     End With
  31.     With ie  'IE視窗最大化
  32.         Application.WindowState = xlMaximized
  33.         .Height = Application.Height
  34.         .Width = Application.Width
  35.         .Quit
  36.     End With
  37. End Sub
  38. Private Sub GetDividend(ByVal ss As String)

  40.     Dim rr As String, T As Date, i, ii, k, j, S
  41.     On Error Resume Next
  42.     T = Time
  43.     rr = "http://yamstock.megatime.com.tw/asp/stockinfo/GetReport.asp?select_table=html\Ficxxx\&stockid=" & ss & "&name1=D4&index1=12"     ' 正確的
  44.     With ie
  45.         .Navigate rr
  46.         Do While .ReadyState <> 4                          '等待網頁下載完畢
  47.               DoEvents
  48.               If Time >= T + #12:00:03 AM# Then            '等待3秒
  49.                 DoEvents
  50.                 Application.SendKeys "~"                    '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
  51.                 Exit Do
  52.               End If
  53.         Loop
  54.         Set S = .Document.getelementsbytagname("table")(11)
  55.         With 工作表2
  56.             .UsedRange.Clear

  58.             For i = 0 To S.Rows.Length - 1      '寫入資料
  59.                 k = k + 1
  60.                 For j = 0 To S.Rows(i).Length - 1
  61.                     For ii = 0 To S.Rows(i).Cells.Length - 1
  62.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innertext
  63.                     DoEvents
  64.                     Next
  65.                 Next
  66.             Next
  67.         End With
  68.     End With

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

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2014-9-1 17:32 | 顯示全部帖子
回復 9# wufonna
要改一下
  1.   Dim AR
  2.     With 工作表1
  3.         AR = .Range("E1:F1")
  4.         .Range("E:F") = ""
  5.         .Range("E1:F1") = AR
  6. '        .Range("E2").CurrentRegion = ""            '清除工作表1,年度範圍
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2014-9-2 14:34 | 顯示全部帖子
回復 12# wufonna
11#所說的錯誤,程式碼在哪發生的.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2014-9-3 16:10 | 顯示全部帖子
回復 14# wufonna
請詳看註解
  1. Private Sub GetDividend(ByVal ss As String)
  2.     Dim rr As String, T As Date, i, ii, k, j, S As Object
  3.     'On Error Resume Next '程式的執行沒有預期的錯誤,此行可不用.
  4.     T = Time
  5.     rr = "http://yamstock.megatime.com.tw/asp/stockinfo/GetReport.asp?select_table=html\Ficxxx\&stockid=" & ss & "&name1=D4&index1=12"     ' 正確的
  6.     With ie
  7.         .Navigate rr
  8.         Do While .readyState <> 4                          '等待網頁下載完畢
  9.               DoEvents
  10.               If Time >= T + #12:00:03 AM# Then            '等待8秒 3秒太少會誤錯改8妙
  11.                 DoEvents
  12.                 Application.SendKeys "~"                    '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
  13.                
  14.                 Exit Do
  15.               End If
  16.         Loop
  17.         ''***不是等待8秒 3秒太少會誤錯改8妙 ***
  18.         Do
  19.         Set S = .Document.getElementsByTagName("table")(4) ' 新的 table 4
  20.         Loop Until Not S Is Nothing
  21.         '*** 勝一 沒捉到 ????
  22.         '*** 因程式運行太快 , S Is Nothing, S 尚未指定為.Document.getElementsByTagName("table")(4)
  23.         '*** 程式已經執行下一行, With 工作表2 的程式碼

  25.         With 工作表2
  26.             .UsedRange.Clear
  27.             For i = 0 To S.Rows.Length - 1      '寫入資料
  28.                 k = k + 1
  29.                 'For j = 0 To S.Rows(i).Length - 1  '這行是錯誤的 也是多餘的迴圈
  30.                    '用 On Error Resume Next 使程式繼續執行
  31.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  32.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  33.                     DoEvents
  34.                     Next
  35.                 'Next
  36.             Next
  37.         End With
  38.     End With
  39. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2014-9-4 16:06 | 顯示全部帖子
本帖最後由 GBKEE 於 2014-9-4 16:25 編輯

回復 21# wufonna
試試看
  1. Option Explicit
  2. Dim ie As Object   '模組最頂端 Dim 供這模組的程序使用的變數
  3. Dim AR()
  4. Sub AllFile()
  5.     Dim i As Integer
  6.     Set ie = CreateObject("internetexplorer.application")   '使用此方式可以免除 "設定引用項目"
  7.     With 工作表1
  8.         AR = .Range("E1:G1")
  9.         .Range("E:G") = ""
  10.         .Range("E1:G1") = AR
  11.         For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
  12.            ReDim AR(1 To 3)
  13.            Application.StatusBar = .Cells(i, 1) & "  " & .Cells(i, 2) & " 讀取中..."
  14.             GetDividend .Cells(i, 1), 3
  15.             GetDividend .Cells(i, 1), 2
  16.             .Range("E1:G1").Offset(i - 1) = AR
  17.         Next
  18.     End With
  19.     ie.Quit
  20. End Sub
  21. Private Sub GetDividend(ByVal ss As String, ByVal table As Integer)
  22.     Dim rr As String, S As Object
  23.     If table = 3 Then
  24.         rr = "http://dj.mybank.com.tw/z/zc/zcc/zcc_" & ss & ".asp.htm"                '股利網頁
  25.     ElseIf table = 2 Then
  26.         rr = "https://djinfo.cathaysec.com.tw/Z/ZC/ZCX/ZCXNEWCATHAYSEC.DJHTM?A=" & ss '收盤價網頁
  27.     End If
  28.     With ie
  29.         .Navigate rr
  30.         Do While .readyState <> 4 Or .Busy                        '等待網頁下載完畢
  31.               DoEvents
  32.         Loop
  33.         With .document.BODY
  34.            If InStr(.INNERTEXT, "個股代碼錯誤") Or InStr(.INNERTEXT, "無此股票資料") Then
  35.                 MsgBox .INNERTEXT
  36.                 Exit Sub
  37.            End If
  38.         End With
  39.         Do
  40.         Set S = .document.getElementsByTagName("table")(table)   ' 新的 table 4
  41.         Loop Until Not S Is Nothing
  42.         If table = 3 Then
  43.             AR(1) = S.Rows(1).Cells(1).INNERTEXT            '現金股利
  44.             AR(2) = S.Rows(1).Cells(4).INNERTEXT            '股票股利
  45.         ElseIf table = 2 Then
  46.             AR(3) = S.Rows(1).Cells(7).INNERTEXT            '收盤價
  47.         End If
  48.     End With
  49. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 能幹不幹，不如苦幹實幹。
返回列表 上一主題