麻辣家族討論版版 - Powered by Discuz! Board

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

複製代碼