[發問] 請教網頁捉取的問題？

wufonna

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

回復 1# wufonna


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

    例如 年/季 在第幾行 謝謝

quickfixer

回復 2# wufonna

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

wufonna

回復 3# quickfixer


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

wufonna

回復 3# quickfixer

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

quickfixer

回復 5# wufonna

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

   

下載 (28.82 KB)

2021-11-18 20:17

wufonna

回復 3# quickfixer

謝謝 大大 可以了

wufonna

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