[µo°Ý] ½Ð±Ðºô­¶®»¨úªº°ÝÃD¡H

wufonna

http://pscnetinvest.moneydj.com.tw/z/zc/zch/zcha_1240.djhtm
http://pscnetinvest.moneydj.com.tw/z/zc/zch/zcha_1565.djhtm

½Ð±Ð¤j¤jÃö©óªÑ²¼ºô­¶¡A­ÓªÑ¤§¶¡ªº®t²§¡A¤£¯à®»¨ú¥¿½Tªº¸ê®Æ¡Aºô­¶®t²§³o¬q¡A
========================================
</td></tr>
<tr><td class="t3n0" colspan="8">
<div id="SysJustWebGraphDIV"></div>
</td></tr>
<tr><td class="t10" colspan="8">ºëµØ(1565)©u¬Õ¾l©ú²Ó
======================================
½Ð°Ý¦p¦ó­×§ïµ{¦¡¡AÁÂÁÂ

Option Explicit
Dim ie As Object   '¼Ò²Õ³Ì³»ºÝ Dim ¨Ñ³o¼Ò²Õªºµ{§Ç¨Ï¥ÎªºÅܼÆ
Sub AllFile()
    Dim i As Integer, v, Y As Integer, S As String
    Dim z As Integer
    Set ie = CreateObject("internetexplorer.application")   '¨Ï¥Î¦¹¤è¦¡¥i¥H§K°£ "³]©w¤Þ¥Î¶µ¥Ø"
    With ie 'ÁY¤pIEµøµ¡
        .Visible = True
        .Width = 5
        .Height = 5
    End With
    With ¤u§@ªí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 = ¤u§@ªí2.Cells(5, 1).Resize(1, 7).Value

             If ¤u§@ªí2.Cells(5, 5).Value > 0 Then
               .Cells(i, 10).Value = 1
               z = z + 1
              Else
               .Cells(i, 10).Value = 0
              End If
                            If ¤u§@ªí2.Cells(5, 5).Value > 0 And ¤u§@ªí2.Cells(6, 5).Value > 0 And ¤u§@ªí2.Cells(7, 5).Value > 0 Then 'K(À禬³s3­Ó¤ë¥¿¦¨ªø)
                .Cells(i, 11).Value = 1
              Else
                .Cells(i, 11).Value = 0
              End If
        Next
'            MsgBox "¦@¦³" & z & "®a¥¿¦¨ªø"
.Cells(1, 10).Value = "¥h¦~¦P´Á¦~¼W²v" & Split(Date, "/")(1) - 1 & "¤ë¥÷" & .Range("A" & .Rows.Count).End(xlUp).Row & "®a¦@¦³" & z & "®a¥¿¦¨ªø"
   
    End With
    With ie  'IEµøµ¡³Ì¤j¤Æ
        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") '­nª`·Nºô­¶½s½X
  End With
  With CreateObject("htmlfile")
        .Write strText
        Set xTable = .all.tags("table")(2)
        With ¤u§@ªí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


    ½Ð°Ý¦³ª¾¹DÀx¦s®æ¸ê®Æ¦ì¦b²Ä´X¦æªº ¤èªk

    ¨Ò¦p ¦~/©u ¦b²Ä´X¦æ ÁÂÁÂ

quickfixer

¦^´_ 2# wufonna

¤£¬O§R±¼¤£­nªº´N¦n¤F
                    Next
            Next
            If .Range("a2") = "" Then .Range("a1:g2").Delete Shift:=xlUp
        End With
  End With

wufonna

¦^´_ 3# quickfixer


  ÁÂÁ ¤j¤jªº¦^´_¡A§Ú¬O­n§ä¥X²Ä¤T©uªº¦ì¸m¡A¾ã²z¥X¸ê®Æ¡A¤£¬O¤ñ¸û¨â­Óªº®t§O

wufonna

¦^´_ 3# quickfixer

¤§«e³o¬O¥Î¨Ó®»À禬ªº¡A¨S³o°ÝÃD

quickfixer

¦^´_ 5# wufonna

§â#2 ¦hªº¨º¤@¦æµ{¦¡½X¥[¦bsub GetDividend
§R±¼¦hªº®æ¤l,²Ä3©uªº¦ì¸m¤£´N¤@¼Ë¤F,¬°¤°»ò­n¦A§ä¤@¦¸?

   

¤U¸ü (28.82 KB)

2021-11-18 20:17

wufonna

¦^´_ 3# quickfixer

ÁÂÁÂ ¤j¤j ¥i¥H¤F

wufonna

Option Explicit
Dim ie As Object   '¼Ò²Õ³Ì³»ºÝ Dim ¨Ñ³o¼Ò²Õªºµ{§Ç¨Ï¥ÎªºÅܼÆ
Sub AllFile()
    Dim i As Integer, v, Y As Integer, S As String
    Dim z As Integer
    Set ie = CreateObject("internetexplorer.application")   '¨Ï¥Î¦¹¤è¦¡¥i¥H§K°£ "³]©w¤Þ¥Î¶µ¥Ø"
    With ie 'ÁY¤pIEµøµ¡
        .Visible = True
        .Width = 5
        .Height = 5
    End With
    With ¤u§@ªí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 = ¤u§@ªí2.Cells(3, 1).Resize(1, 7).Value

             If ¤u§@ªí2.Cells(3, 5).Value > 0 Then
               .Cells(i, 10).Value = 1
               z = z + 1
              Else
               .Cells(i, 10).Value = 0
              End If
                            If ¤u§@ªí2.Cells(3, 5).Value > 0 And ¤u§@ªí2.Cells(4, 5).Value > 0 And ¤u§@ªí2.Cells(5, 5).Value > 0 Then 'K(À禬³s3­Ó¤ë¥¿¦¨ªø)
                .Cells(i, 11).Value = 1
              Else
                .Cells(i, 11).Value = 0
              End If
        Next
'            MsgBox "¦@¦³" & z & "®a¥¿¦¨ªø"
.Cells(1, 10).Value = "¥h¦~¦P´Á¦~¼W²v" & Split(Date, "/")(1) - 1 & "¤ë¥÷" & .Range("A" & .Rows.Count).End(xlUp).Row & "®a¦@¦³" & z & "®a¥¿¦¨ªø"
   
    End With
    With ie  'IEµøµ¡³Ì¤j¤Æ
        Application.WindowState = xlMaximized
        .Height = Application.Height
        .Width = Application.Width
        .Quit
    End With
End Sub

Private Sub GetDividend(ByVal ss As String)     '¨úªÑ§Qºô­¶
  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") '­nª`·Nºô­¶½s½X
  End With
  With CreateObject("htmlfile")
        .Write strText
        Set xTable = .all.tags("table")(2)
        With ¤u§@ªí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 '­×§ï¥[³o¦æºU¦Ò 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