[µo°Ý] ½Ð°Ý³o¥i³]©wµ¥´X¬í¨S¶}ºô­¶©Îºô­¶¿ù»~´N°õ¦æ¤U¤@µ§¶Ü¡AÁÂÁÂ

wufonna

Private Sub GetDividend(ByVal ss As String)
    Dim rr As String

   rr = "http://yamstock.megatime.com.tw/asp/stockinfo/GetReport.asp?select_table=html\Ficxxx\&stockid=2412&" & ss & "&name1=D4&index1=12"     ' ¥¿½Tªº
    ¤u§@ªí2.Select
    Cells.Clear

    Set ie = CreateObject("internetexplorer.application") '¨Ï¥Î¦¹¤è¦¡¥i¥H§K°£ "³]©w¤Þ¥Î¶µ¥Ø"

    With ie
        .Visible = False 'True¬°¶}±Òie, False¬°¤£¶}±Òie
        .Navigate rr
        Do While .ReadyState <> 4 'µ¥«Ýºô­¶¶}±Ò
        DoEvents
        Loop
        .ExecWB 17, 2 'Select All
        .ExecWB 12, 2 'Copy selection
        
        ¤u§@ªí2.Range("A1").Activate
        
        ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
            False, NoHTMLFormatting:=True
    End With

     ie.Quit
   End Sub

Sub AllFile()
Dim i As Integer, v

On Error Resume Next
For i = 2 To ¤u§@ªí1.Range("A" & ¤u§@ªí1.Rows.Count).End(xlUp).Row

v = ¤u§@ªí1.Cells(i, 1).Value

Call GetDividend(v)
¤u§@ªí1.Cells(i, 9).Value = ¤u§@ªí2.Cells(34, 8).Value
Debug.Print ¤u§@ªí1.Cells(i, 1).Value & " " & ¤u§@ªí1.Cells(i, 2).Value

Next

End Sub

wufonna

¦^´_ 28# quickfixer


    ÁÂÁÂ ¤j¤j
­×§ï

1. Sub test()
   
2. Debug.Print Date
   
3. '­×§ï1¤ëªº«e¤@­Ó¤ë«K0
   
4. If Split(Date, "/")(1) - 1 = 0 Then
   
5. Debug.Print 12
   
6. Else
   
7. Debug.Print Split(Date, "/")(1) - 1
   
8. End If
   
9. 
   
10. End Sub

½Æ»s¥N½X

wufonna

¦^´_ 28# quickfixer


    ÁÂÁÂ ¤j¤j
¤§«eµ{¦¡¥i¶]§¹¡A¥i¯à³o¨â¤ÑÀ禬§ó·s¡Aºô­¶¤~¦³¯Ê¤Ö¸ê®Æ¡Aµ¥ºô­¶§ó·s§¹¦b¤U¸ü¬Ý¬Ý¡C
¥[¤Fµ{¦¡½Xµ{¦¡¦³¶]§¹¡C

quickfixer

¦^´_ 27# quickfixer

§Ú°Ñ¦Ò§Aµ¹ªº01ºô§}686f,¥[¤J­«·s¤U¸ü¥\¯à,¥i¥þ³¡¶]§¹

1. Private Sub GetDividend(ByVal ss As String)     '¨úªÑ§Qºô­¶ '2022/2/22 ´«³o¬qµ{¦¡½X ¦b https://www.mobile01.com/topicdetail.php?f=511&t=4737630&p=3 ªº21¼Ó
   
2. Dim URL, HTMLsourcecode, GetXml, Table
   
3. Dim i As Integer, j As Integer, r As Integer
   
4. Set HTMLsourcecode = CreateObject("htmlfile")
   
5. Set GetXml = CreateObject("msxml2.xmlhttp")
   
6. URL = "http://pscnetinvest.moneydj.com.tw/z/zc/zch/zch_" & ss & ".djhtm"
   
7. 
   
8. r = 0
   
9. retry:
   
10. On Error Resume Next
    
11. 
    
12. With GetXml
    
13. .Open "GET", URL, False
    
14. .setRequestHeader "Cache-Control", "no-cache"
    
15. .setRequestHeader "Pragma", "no-cache"
    
16. .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    
17. .send
    
18. 
    
19. HTMLsourcecode.body.innerhtml = .responsetext
    
20. Set Table = HTMLsourcecode.all.tags("table")(2).Rows
    
21. 
    
22. If Err.Number <> 0 Then
    
23. 
    
24. If r > 3 Then
    
25. '¶W¹L3¦¸,§ï§ì¤U¤@µ§,ÁקKµL­­loop
    
26. Exit Sub
    
27. End If
    
28. Debug.Print Err.Description
    
29. r = r + 1
    
30. On Error GoTo -1
    
31. Err.Clear
    
32. 'µ¥0.5¬í
    
33. Delaytick (0.5)
    
34. GoTo retry
    
35. 
    
36. End If
    
37.             
    
38. For i = 0 To Table.Length - 1
    
39. For j = 0 To Table(i).Cells.Length - 1
    
40. ¤u§@ªí2.Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
    
41. Next j
    
42. Next i
    
43. End With
    
44. Set HTMLsourcecode = Nothing
    
45. Set GetXml = Nothing
    
46. End Sub
    
47. 
    
48. 
    
49. 
    
50. Sub Delaytick(setdelay As Single)
    
51.    
    
52.     Dim StartTime As Double, NowTime As Double
    
53.     StartTime = Timer * 100
    
54.     setdelay = setdelay * 100
    
55.     Do
    
56.       NowTime = Timer * 100
    
57.       DoEvents
    
58.     Loop Until NowTime - StartTime > setdelay
    
59.    
    
60. End Sub

½Æ»s¥N½X

¦ý¬O§Aallfile¸Ì­±¨º­ÓSplit(Date, "/")(1) - 1
¥i¯à­n§ï¤@¤U,¦³¤Hexcel¤é´Á¬O¥Î-¤£¬O/
¥Îmid¥i¯à·|¤ñ¸û¦n¤@¨Ç

quickfixer

¦^´_ 26# wufonna

¨Sª`·N¨ìSelectionChange¸Ì­±¦³­«§ìªºµ{¦¡½X

¥X¿ù®É    debug.print HTMLsourcecode.body.innerhtml ¥X²{³o­Ó,¨S¦³§ì¨ì¸ê®Æ

2022-2-12 22:38

google httpcode=500
¦øªA¾¹ºÝ¿ù»~¦^À³
500 Internal Server Error
¦øªA¾¹ºÝµo¥Í¥¼ª¾©ÎµLªk³B²zªº¿ù»~¡C

¥i¯àµ{¦¡¶]¤Ó§Ö,¦P­Óip½Ð¨D¤Ó¦h,ºô­¶¨Ó¤£¤Î³B²z

wufonna

¦^´_ 25# quickfixer


    ÁÂÁ ¤j¤j ¡A§Ú¦³¥Î

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Application.EnableEvents = False
   
3.         If Target(1).Column = 1 And Target(1).Address(0, 0) <> "A1" Then          '¦b²Ä1¦C
   
4.             If Target(1).Value <> "" Then
   
5.             
   
6. '         MsgBox Target(1).Address(0, 0) & vbCrLf & vbCrLf & Target(1).Value & vbCrLf & vbCrLf & Target(1).Row
   
7.             Call MyFile(Target(1).Value, Target(1).Row)
   
8.             End If
   
9.         End If
   
10.     Application.EnableEvents = True
    
11. 
    
12. End Sub

½Æ»s¥N½X

§ì¨ú­Ó§Oªº¸ê®Æ
·Q½Ð±Ð¦³µ{¦¡¨ú¥N
On Error Resume Next '¤U¦æ·|¥X¿ù¡A¥[¤J³o¦æ¡A¥¼ª¾­ì¦]¡C
³o¬qµ{¦¡½X¶Ü

quickfixer

¦^´_ 24# wufonna


    ª±¤F¤@¤U,·|¥X¿ù¬O¨S§ì¨ì¸ê®Æ,¦n¹³¬Oµ{¦¡¶]¤Ó§Ö,¬y¶q­­¨îªº°ÝÃD,¥i¬O¨S¾×ip?
µ{¦¡¨S°ÝÃD,¥t¥~°µ¤@­Ócommandbutton,¥þ³¡½s¸¹¶]§¹«á,¦A­«§ì¦³ªÅ¥Õªº¸ê®Æ
Sub test()
    With ¤u§@ªí1
        For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
¥u§ì¨S¸ê®Æªº½s¸¹
           If .Cells(i, 3) = "" Then
            v = .Cells(i, 1).Value
            GetDividend (v)
'³o´X¦æcode ¦P AllFile ,®¤§R
           End If
        Next
    End With
End Sub

wufonna

¦^´_ 1# wufonna
§ï¤Fµ{¦¡¤º®e

½Ð±Ðµ{¦¡¨S¥[¤J³o¬q On Error Resume Next '¤U¦æ·|¥X¿ù¡A¥[¤J³o¦æ¡A¥¼ª¾­ì¦]¡C ·|¿ù»~¬Oºô­¶¦³ªÅ®æªºÃö·Ë¶Ü?
½Ð±Ð¤j¤j¦p¦ó­×§ï ÁÂÁÂ

1. Option Explicit
   
2. Dim ie As Object   '¼Ò²Õ³Ì³»ºÝ Dim ¨Ñ³o¼Ò²Õªºµ{§Ç¨Ï¥ÎªºÅܼÆ
   
3. Sub AllFile()
   
4.     Dim i As Integer, v, Y As Integer, S As String
   
5.     Dim z As Integer
   
6. 
   
7.     With ¤u§@ªí1
   
8.         Dim AR
   
9.            AR = .Range("C1:J1")
   
10.           .Range("C:J") = ""
    
11.           .Range("C1:J1") = AR
    
12.           z = 0
    
13.         For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
    
14.      
    
15.            v = .Cells(i, 1).Value
    
16.             GetDividend (v)
    
17.              .Cells(i, 3).Resize(1, 7).Value = ¤u§@ªí2.Cells(7, 1).Resize(1, 7).Value
    
18. 
    
19.              If ¤u§@ªí2.Cells(7, 5).Value > 0 Then
    
20.                .Cells(i, 10).Value = 1
    
21.                z = z + 1
    
22.               Else
    
23.                .Cells(i, 10).Value = 0
    
24.               End If
    
25.                             If ¤u§@ªí2.Cells(7, 5).Value > 0 And ¤u§@ªí2.Cells(8, 5).Value > 0 And ¤u§@ªí2.Cells(9, 5).Value > 0 Then 'K(À禬³s3­Ó¤ë¥¿¦¨ªø)
    
26.                 .Cells(i, 11).Value = 1
    
27.               Else
    
28.                 .Cells(i, 11).Value = 0
    
29.               End If
    
30.         Next
    
31. '            MsgBox "¦@¦³" & z & "®a¥¿¦¨ªø"
    
32. .Cells(1, 10).Value = "¥h¦~¦P´Á¦~¼W²v" & Split(Date, "/")(1) - 1 & "¤ë¥÷" & .Range("A" & .Rows.Count).End(xlUp).Row & "®a¦@¦³" & z & "®a¥¿¦¨ªø"
    
33.    
    
34.     End With
    
35. 
    
36. End Sub
    
37. 
    
38. Public Function MyFile(v As Integer, i As Integer)
    
39.   '   Dim i As Integer, v, Y As Integer, S As String
    
40. 
    
41.     With ¤u§@ªí1
    
42.            .Range("C" & v & ":J" & v) = "" '²M°£¤u§@ªí1,¦~«×½d³ò
    
43.            v = .Cells(i, 1).Value
    
44.             GetDividend (v)
    
45.              .Cells(i, 3).Resize(1, 7).Value = ¤u§@ªí2.Cells(7, 1).Resize(1, 7).Value
    
46. 
    
47.              If ¤u§@ªí2.Cells(7, 5).Value > 0 Then
    
48.                .Cells(i, 10).Value = 1
    
49. 
    
50.               Else
    
51.                .Cells(i, 10).Value = 0
    
52.               End If
    
53.               If ¤u§@ªí2.Cells(7, 5).Value > 0 And ¤u§@ªí2.Cells(8, 5).Value > 0 And ¤u§@ªí2.Cells(9, 5).Value > 0 Then 'k (À禬³s3­Ó¤ë¥¿¦¨ªø)
    
54.                 .Cells(i, 11).Value = 1
    
55.               Else
    
56.                 .Cells(i, 11).Value = 0
    
57.               End If
    
58.               
    
59.     End With
    
60. 
    
61. End Function
    
62. 
    
63. 
    
64. 
    
65. Private Sub GetDividend(ByVal ss As String)     '¨úªÑ§Qºô­¶ '2022/2/22 ´«³o¬qµ{¦¡½X ¦b https://www.mobile01.com/topicdetail.php?f=511&t=4737630&p=3 ªº21¼Ó
    
66. Dim URL, HTMLsourcecode, GetXml, Table
    
67. Dim i As Integer, j As Integer
    
68. Set HTMLsourcecode = CreateObject("htmlfile")
    
69. Set GetXml = CreateObject("msxml2.xmlhttp")
    
70. URL = "http://pscnetinvest.moneydj.com.tw/z/zc/zch/zch_" & ss & ".djhtm"
    
71. With GetXml
    
72. .Open "GET", URL, False
    
73. .setRequestHeader "Cache-Control", "no-cache"
    
74. .setRequestHeader "Pragma", "no-cache"
    
75. .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    
76. .send
    
77. 
    
78. HTMLsourcecode.body.innerhtml = .responsetext
    
79. On Error Resume Next '¤U¦æ·|¥X¿ù¡A¥[¤J³o¦æ¡A¥¼ª¾­ì¦]¡C
    
80. Set Table = HTMLsourcecode.all.tags("table")(2).Rows
    
81. For i = 0 To Table.Length - 1
    
82. For j = 0 To Table(i).Cells.Length - 1
    
83. ¤u§@ªí2.Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
    
84. Next j
    
85. Next i
    
86. End With
    
87. Set HTMLsourcecode = Nothing
    
88. Set GetXml = Nothing
    
89. End Sub

½Æ»s¥N½X

wufonna

¦^´_ 22# GBKEE

·PÁÂ GBKEE ¤j
µ{¦¡¶]¤F´X¦¸³£¯à®»¨ì
µ{¦¡½X§Ú¬ã¨s¬Ý¬Ý ¤£·|¦A¦V GBKEE ¤j¤j½Ð±Ð
ÁÂÁÂ ^_^

GBKEE

¦^´_ 21# wufonna
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Dim ie As Object   '¼Ò²Õ³Ì³»ºÝ Dim ¨Ñ³o¼Ò²Õªºµ{§Ç¨Ï¥ÎªºÅܼÆ
   
3. Dim AR()
   
4. Sub AllFile()
   
5.     Dim i As Integer
   
6.     Set ie = CreateObject("internetexplorer.application")   '¨Ï¥Î¦¹¤è¦¡¥i¥H§K°£ "³]©w¤Þ¥Î¶µ¥Ø"
   
7.     With ¤u§@ªí1
   
8.         AR = .Range("E1:G1")
   
9.         .Range("E:G") = ""
   
10.         .Range("E1:G1") = AR
    
11.         For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
    
12.            ReDim AR(1 To 3)
    
13.            Application.StatusBar = .Cells(i, 1) & "  " & .Cells(i, 2) & " Ū¨ú¤¤..."
    
14.             GetDividend .Cells(i, 1), 3
    
15.             GetDividend .Cells(i, 1), 2
    
16.             .Range("E1:G1").Offset(i - 1) = AR
    
17.         Next
    
18.     End With
    
19.     ie.Quit
    
20. End Sub
    
21. Private Sub GetDividend(ByVal ss As String, ByVal table As Integer)
    
22.     Dim rr As String, S As Object
    
23.     If table = 3 Then
    
24.         rr = "http://dj.mybank.com.tw/z/zc/zcc/zcc_" & ss & ".asp.htm"                'ªÑ§Qºô­¶
    
25.     ElseIf table = 2 Then
    
26.         rr = "https://djinfo.cathaysec.com.tw/Z/ZC/ZCX/ZCXNEWCATHAYSEC.DJHTM?A=" & ss '¦¬½L»ùºô­¶
    
27.     End If
    
28.     With ie
    
29.         .Navigate rr
    
30.         Do While .readyState <> 4 Or .Busy                        'µ¥«Ýºô­¶¤U¸ü§¹²¦
    
31.               DoEvents
    
32.         Loop
    
33.         With .document.BODY
    
34.            If InStr(.INNERTEXT, "­ÓªÑ¥N½X¿ù»~") Or InStr(.INNERTEXT, "µL¦¹ªÑ²¼¸ê®Æ") Then
    
35.                 MsgBox .INNERTEXT
    
36.                 Exit Sub
    
37.            End If
    
38.         End With
    
39.         Do
    
40.         Set S = .document.getElementsByTagName("table")(table)   ' ·sªº table 4
    
41.         Loop Until Not S Is Nothing
    
42.         If table = 3 Then
    
43.             AR(1) = S.Rows(1).Cells(1).INNERTEXT            '²{ª÷ªÑ§Q
    
44.             AR(2) = S.Rows(1).Cells(4).INNERTEXT            'ªÑ²¼ªÑ§Q
    
45.         ElseIf table = 2 Then
    
46.             AR(3) = S.Rows(1).Cells(7).INNERTEXT            '¦¬½L»ù
    
47.         End If
    
48.     End With
    
49. End Sub

½Æ»s¥N½X