Dim StockArr As variable
StockArr = Array(9946,2330,2317,5522)'等等的股票
Dim E As Object, i As Integer, ii As Integer, k As Integer
Dim xadte As Date
xadte = DateAdd("yyyy", -1, Date) '日期(起)：
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.cnyes.com/twstock/intro/9946.htm"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Set E = .document.getElementsByTAGName("TABLE")(4)
ActiveSheet.UsedRange.Clear
For i = 0 To E.Rows.Length - 1
k = k + 1
For ii = 0 To E.Rows(i).Cells.Length - 1
Cells(k, ii + 1) = E.Rows(i).Cells(ii).INNERTEXT
Next
Next
.Quit '關閉網頁
End With
Dim yadte As Date
yadte = DateAdd("yyyy", -1, Date) '日期(起)：
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://pchome.megatime.com.tw/stock/9946.html"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Set E = .document.getElementsByTAGName("TABLE")(4)
For i = 0 To E.Rows.Length - 1
k = k + 1
For ii = 0 To E.Rows(i).Cells.Length - 1
Cells(k, ii + 1) = E.Rows(i).Cells(ii).INNERTEXT
Next
Next
.Quit '關閉網頁
End With
Dim R As Range, Rng As Range
For Each R In ActiveSheet.Range("A:A").SpecialCells(xlCellTypeConstants).Rows
'ActiveSheet(作用工作表) SpecialCells(xlCellTypeConstants "包含常數的儲存格")
If Not IsError(Application.Match("相關權證", R, 0)) Then
'工作表函數Match 尋找到0 傳回數字,找不到0 傳回錯誤值 #N/A
If Rng Is Nothing Then Set Rng = R Else Set Rng = Union(R, Rng)
'Union 方法 傳回兩個或多個範圍的合併範圍。
End If
Next
If Not Rng Is Nothing Then Rng.EntireRow.Delete '範圍整欄刪除作者: luhpro 時間: 2014-12-29 00:43
