- Option Explicit
- Dim ie As Object '模組最頂端 Dim 供這模組的程序使用的變數
- Sub AllFile()
- Dim i As Integer, v, Y As Integer, S As String
- Dim z As Integer
- Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
- With ie '縮小IE視窗
- .Visible = True
- .Width = 5
- .Height = 5
- End With
- With 工作表1
- Dim AR
- AR = .Range("C1:J1")
- .Range("C:J") = ""
- .Range("C1:J1") = AR
- z = 0
- For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
-
- v = .Cells(i, 1).Value
- GetDividend (v)
- .Cells(i, 3).Resize(1, 7).Value = 工作表2.Cells(7, 1).Resize(1, 7).Value
- If 工作表2.Cells(7, 5).Value > 0 Then
- .Cells(i, 10).Value = 1
- z = z + 1
- Else
- .Cells(i, 10).Value = 0
- End If
- If 工作表2.Cells(7, 5).Value > 0 And 工作表2.Cells(8, 5).Value > 0 And 工作表2.Cells(9, 5).Value > 0 Then 'K(營收連3個月正成長)
- .Cells(i, 11).Value = 1
- Else
- .Cells(i, 11).Value = 0
- End If
- Next
- ' MsgBox "共有" & z & "家正成長"
- .Cells(1, 10).Value = "去年同期年增率" & Split(Date, "/")(1) - 1 & "月份" & .Range("A" & .Rows.Count).End(xlUp).Row & "家共有" & z & "家正成長"
-
- End With
- With ie 'IE視窗最大化
- Application.WindowState = xlMaximized
- .Height = Application.Height
- .Width = Application.Width
- .Quit
- End With
- End Sub
- Public Function MyFile(v As Integer, i As Integer)
- ' Dim i As Integer, v, Y As Integer, S As String
- Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
- With ie '縮小IE視窗
- .Visible = True
- .Width = 5
- .Height = 5
- End With
- With 工作表1
- .Range("C" & v & ":J" & v) = ""
- ' .Range("E2").CurrentRegion = "" '清除工作表1,年度範圍
- v = .Cells(i, 1).Value
- GetDividend (v)
- .Cells(i, 3).Resize(1, 7).Value = 工作表2.Cells(7, 1).Resize(1, 7).Value
- If 工作表2.Cells(7, 5).Value > 0 Then
- .Cells(i, 10).Value = 1
- ' z = z + 1
- Else
- .Cells(i, 10).Value = 0
- End If
- If 工作表2.Cells(7, 5).Value > 0 And 工作表2.Cells(8, 5).Value > 0 And 工作表2.Cells(9, 5).Value > 0 Then 'k (營收連3個月正成長)
- .Cells(i, 11).Value = 1
- Else
- .Cells(i, 11).Value = 0
- End If
-
- End With
- With ie 'IE視窗最大化、
- Application.WindowState = xlMaximized
- .Height = Application.Height
- .Width = Application.Width
- .Quit
- End With
- End Function
- Private Sub GetDividend(ByVal ss As String) '取股利網頁
- Dim rr As String, T As Date, i, ii, k, j, S As Object
- 'On Error Resume Next '程式的執行沒有預期的錯誤,此行可不用.
- T = Time
- ' rr = "http://dj.mybank.com.tw/z/zc/zch/zch_" & ss & ".asp.htm"
- 'rr = "http://www.emega.com.tw/z/zc/zch/zch_" & ss & ".ASP.HTM"
- rr = "http://pscnetinvest.moneydj.com.tw/z/zc/zch/zch_" & ss & ".djhtm"
- With ie
- .Navigate rr
- Do While .readyState <> 4 '等待網頁下載完畢
- DoEvents
- If Time >= T + #12:00:03 AM# Then '等待3秒
- DoEvents
- Application.SendKeys "~" '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
-
- Exit Do
- End If
- Loop
- ''***不是等待8秒 3秒太少會誤錯改8妙 ***
- Do
- Set S = .Document.getElementsByTagName("table")(2) ' 新的 table 4
- Loop Until Not S Is Nothing
- '*** 勝一 沒捉到 ????
- '*** 因程式運行太快 , S Is Nothing, S 尚未指定為.Document.getElementsByTagName("table")(4)
- '*** 程式已經執行下一行, With 工作表2 的程式碼
- With 工作表2
- .UsedRange.Clear
- For i = 0 To S.Rows.Length - 1 '寫入資料
- k = k + 1
- '用 On Error Resume Next 使程式繼續執行
- For ii = 0 To S.Rows(i).Cells.Length - 1 ' S.Rows(i).Cells.Length - 1 才是正確
- .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
- DoEvents
- Next
- Next
- End With
- End With
- End Sub
複製代碼 |