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

標題: [發問] 請教網頁捉取的問題？ [打印本頁]

作者: wufonna 時間: 2021-11-18 18:22 標題: 請教網頁捉取的問題？

http://pscnetinvest.moneydj.com.tw/z/zc/zch/zcha_1240.djhtm
http://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

作者: wufonna 時間: 2021-11-18 19:31

回復 1# wufonna

請問有知道儲存格資料位在第幾行的方法

例如年/季在第幾行謝謝

作者: quickfixer 時間: 2021-11-18 19:54

回復 2# wufonna

不是刪掉不要的就好了
                  Next
         Next
         If .Range("a2") = "" Then .Range("a1:g2").Delete Shift:=xlUp
      End With
  End With

作者: wufonna 時間: 2021-11-18 20:12

回復 3# quickfixer

謝謝大大的回復，我是要找出第三季的位置，整理出資料，不是比較兩個的差別

作者: wufonna 時間: 2021-11-18 20:14

回復 3# quickfixer

之前這是用來捉營收的，沒這問題

作者: quickfixer 時間: 2021-11-18 20:20

本帖最後由 quickfixer 於 2021-11-18 20:26 編輯

回復 5# wufonna

把#2 多的那一行程式碼加在sub GetDividend
刪掉多的格子,第3季的位置不就一樣了,為什麼要再找一次?

[attach]34406[/attach]

作者: wufonna 時間: 2021-11-18 20:27

本帖最後由 wufonna 於 2021-11-18 20:28 編輯

回復 3# quickfixer

謝謝大大可以了

作者: wufonna 時間: 2021-11-18 20:37

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 '修改加這行摻考 http://forum.twbts.com/thread-23487-1-1.html
      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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)