請教網頁捉取的問題？
http://pscnetinvest.moneydj.com.tw/z/zc/zch/zcha_1240.djhtmhttp://pscnetinvest.moneydj.com.tw/z/zc/zch/zcha_1565.djhtm
請教大大關於股票網頁，個股之間的差異，不能捉取正確的資料，網頁差異這段，
========================================
</td></tr>
<tr><td class="t3n0" colspan="8">
<div id="SysJustWebGraphDIV"></div>
</td></tr>
<tr><td class="t10" colspan="8">精華(1565)季盈餘明細
======================================
請問如何修改程式，謝謝
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(5, 1).Resize(1, 7).Value
If 工作表2.Cells(5, 5).Value > 0 Then
.Cells(i, 10).Value = 1
z = z + 1
Else
.Cells(i, 10).Value = 0
End If
If 工作表2.Cells(5, 5).Value > 0 And 工作表2.Cells(6, 5).Value > 0 And 工作表2.Cells(7, 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
Private Sub GetDividend(ByVal ss As String)
Dim strText As String
Dim i As Integer, j As Integer, xTable As Object
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://pscnetinvest.moneydj.com.tw/z/zc/zch/zcha_" & ss & ".djhtm", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send
strText = BinToStr(.responseBody, "BIG5") '要注意網頁編碼
End With
With CreateObject("htmlfile")
.Write strText
Set xTable = .all.tags("table")(2)
With 工作表2
.Cells.Clear
For i = 0 To xTable.Rows.Length - 1
For j = 0 To xTable.Rows(i).Cells.Length - 1
.Cells(i + 1, j + 1) = xTable.Rows(i).Cells(j).innertext
Next
Next
End With
End With
End Sub
Function BinToStr(arrBin, strChrs)
With CreateObject("ADODB.Stream")
.Type = 2
.Open
.Writetext arrBin
.Position = 0
.Charset = strChrs
BinToStr = .ReadText
.Close
End With
End Function [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117738&ptid=23487]1#[/url] [i]wufonna[/i] [/b]
請問有知道儲存格資料位在第幾行的 方法
例如 年/季 在第幾行 謝謝 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117739&ptid=23487]2#[/url] [i]wufonna[/i] [/b]
不是刪掉不要的就好了
Next
Next
If .Range("a2") = "" Then .Range("a1:g2").Delete Shift:=xlUp
End With
End With [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117741&ptid=23487]3#[/url] [i]quickfixer[/i] [/b]
謝謝 大大的回復，我是要找出第三季的位置，整理出資料，不是比較兩個的差別 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117741&ptid=23487]3#[/url] [i]quickfixer[/i] [/b]
之前這是用來捉營收的，沒這問題 [i=s] 本帖最後由 quickfixer 於 2021-11-18 20:26 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117743&ptid=23487]5#[/url] [i]wufonna[/i] [/b]
把#2 多的那一行程式碼加在sub GetDividend
刪掉多的格子,第3季的位置不就一樣了,為什麼要再找一次?
[attach]34406[/attach] [i=s] 本帖最後由 wufonna 於 2021-11-18 20:28 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117741&ptid=23487]3#[/url] [i]quickfixer[/i] [/b]
謝謝 大大 可以了 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(3, 1).Resize(1, 7).Value
If 工作表2.Cells(3, 5).Value > 0 Then
.Cells(i, 10).Value = 1
z = z + 1
Else
.Cells(i, 10).Value = 0
End If
If 工作表2.Cells(3, 5).Value > 0 And 工作表2.Cells(4, 5).Value > 0 And 工作表2.Cells(5, 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
Private Sub GetDividend(ByVal ss As String) '取股利網頁
Dim strText As String
Dim i As Integer, j As Integer, xTable As Object
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://pscnetinvest.moneydj.com.tw/z/zc/zch/zcha_" & ss & ".djhtm", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send
strText = BinToStr(.responseBody, "BIG5") '要注意網頁編碼
End With
With CreateObject("htmlfile")
.Write strText
Set xTable = .all.tags("table")(2)
With 工作表2
.Cells.Clear
For i = 0 To xTable.Rows.Length - 1
For j = 0 To xTable.Rows(i).Cells.Length - 1
.Cells(i + 1, j + 1) = xTable.Rows(i).Cells(j).innertext
Next
Next
If .Range("a2") = "" Then .Range("a1:g2").Delete Shift:=xlUp '修改加這行摻考 [url]http://forum.twbts.com/thread-23487-1-1.html[/url]
End With
End With
End Sub
Function BinToStr(arrBin, strChrs)
With CreateObject("ADODB.Stream")
.Type = 2
.Open
.Writetext arrBin
.Position = 0
.Charset = strChrs
BinToStr = .ReadText
.Close
End With
End Function
頁:
[1]