GBKEE

¦^´_ 11# wufonna
Pchome ªº½u«¬¨«¶Õ ºô­¶  VBA °Ñ¦Ò ¬Ý¬Ý

1. Option Explicit
   
2. Dim Rng As Range, ¸ê°T_Msg As Boolean, ie As New InternetExplorer
   
3. Sub AllFile()    '­«·s§ó·s©Ò¦³¸ê®Æ
   
4.     Dim i As Integer
   
5.     With Sheets("ªÑ²¼")
   
6.         .UsedRange.CurrentRegion.Offset(0, 1).Clear
   
7.         ¸ê°T_Msg = True
   
8.         For i = 1 To .Range("A" & .Rows.Count).End(xlUp).Row
   
9.             µ{¦¡°õ¦æ Cells(i, 1)
   
10.         Next
    
11.         ¸ê°T_Msg = False
    
12.         If ¸ê°T_Msg = False Then ie.Quit
    
13.     End With
    
14. End Sub
    
15. Sub ex()
    
16.     µ{¦¡°õ¦æ [B1]
    
17. End Sub
    
18. Private Sub µ{¦¡°õ¦æ(xRng As Range)  '³æµ§§ó·s «ü©wAÄ檺¸ê®Æ
    
19.     If xRng.Column > 1 Then MsgBox xRng & " ¤£¦b AÄæ": Exit Sub
    
20.    ' If ie Is Nothing Then Set ie = New InternetExplorer
    
21.     Set Rng = xRng
    
22.     ªÑ²¼¸ê°T
    
23.     Rng.Select
    
24.     If ¸ê°T_Msg = False Then ie.Quit
    
25. End Sub
    
26. Sub ªÑ²¼¸ê°T()
    
27.     Dim E As Object, Ar(), A As Integer, R As Integer, C As Integer
    
28.     With Rng
    
29.         A = .Parent.UsedRange.Columns.Count - 1
    
30.         If ¸ê°T_Msg = False Then
    
31.         .Offset(, 1).Resize(, A).Select
    
32.         .Offset(, 1).Resize(, A).Clear
    
33.         End If
    
34.         If .Row = 1 Then .Cells(1, 2) = "ªÑ²¼¦WºÙ ": .Cells(1, 3) = "ªÑ²¼»ù®æ "
    
35.     End With
    
36. On Error GoTo Beerr
    
37. Be:
    
38.     With ie
    
39.     DoEvents
    
40.         .Navigate "https://pchome.megatime.com.tw/stock/sid" & Rng & ".html" '
    
41.        '   .Visible = True
    
42.          Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
43.          Do: DoEvents
    
44.             If InStr(.Document.body.innertext, "¬dµL") Then  '¬dµL ªÑ²¼¥N¸¹
    
45.                 Rng.Offset(, 1) = "¬dµL " & Rng: Exit Sub
    
46.                 ie.Quit
    
47.             End If
    
48.          Loop Until Not InStr(.Document.body.innertext, "¬dµL")
    
49.          If Rng.Row > 1 Then
    
50.             Do: DoEvents
    
51.                 Set E = .Document.querySelector("em[class='corp-name']")  '«ü©w³o¤¸¯À  <em>  Åª¨ú   (ªÑ²¼¦WºÙ, ¥N¸¹)
    
52.                    '<em class="corp-name">¥x¡@ªd<span class="stock-code">&nbsp;&nbsp;(1101)</span> </em>
    
53.             Loop Until TypeName(E) = "HTMLPhraseElement"
    
54.             If Trim(E.ALL.TAGS("SPAN")(0).innertext) <> "(" & Rng & ")" Then
    
55.                 Rng.Offset(, 1) = "¬dµL " & Rng: Exit Sub
    
56.             Else
    
57.                 Rng.Cells(, 2) = Trim(Split(E.innertext, "(")(0))  'Split ¨ç¼Æ  ¶Ç¦^¤@­Ó³¯¦C¯Á¤Þ±q¹s¶}©lªº¤@ºû°}¦C , ¥¦¥]§t«ü©w¼Æ¥Øªº¤l¦r¦ê
    
58.             End If
    
59.             Set E = .Document.getelementbyid("stock_info_data_a").ALL.TAGS("SPAN")(0)    'ªÑ²¼»ù®æ    id="stock_info_data_a"
    
60.              '<div class="price s-down fadein_black" id="stock_info_data_a">
    
61.             '<span class="data_close s-down">18.95</span> **TAGS("SPAN")(0)   's-down ªÑ»ù¤U­°
    
62.             '<span class="data_diff s-down">¡¿-0.10</span> **TAGS("SPAN")(1)
    
63.             '<span class="data_diff s-down">-0.52%</span>  **TAGS("SPAN")(2)
    
64.            '<span class="data_total">18.79<em>»õ</em></span></div>  **TAGS("SPAN")(3)
    
65.             Rng.Cells(, 3) = E.innertext
    
66.         End If
    
67.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
68.         Do: DoEvents
    
69.             Set E = .Document.ALL.TAGS("table")(1)
    
70.         Loop Until TypeName(E) = "HTMLTable"
    
71.          If Rng.Row > 1 Then Ar = Array(3, 5, 7, 9) Else Ar = Array(2, 4, 6, 8)
    
72.                     'Rng.Row > 1 >>±q²Ä2¦C¶}©l¤U¸ü¸ê®Æ
    
73.                      'Array(2, 4, 6, 8) ¬°¼ÐÃDªºRow  **Ar = Array(3, 5, 7, 9 )¬°¸ê®ÆªºRow
    
74.         A = 4  '³]©w¸ê®ÆÄæ¦ìªº°_©lÄæ¦ì,«e¦³ 1ªÑ²¼¥N½XÄæ,2ªÑ²¼¦WºÙÄæ,3ªÑ²¼»ù®æÄæ
    
75.        For R = 0 To UBound(Ar) - 1
    
76.            For C = 0 To E.Rows(Ar(R)).Cells.Length - 1
    
77.             Rng.Cells(, A) = E.Rows(Ar(R)).Cells(C).innertext
    
78.             A = A + 1  '¸ê®ÆÄæ¦ì+1
    
79.            Next
    
80.        Next
    
81.     End With
    
82. Exit Sub
    
83. Beerr:
    
84. Set ie = New InternetExplorer
    
85. GoTo Be
    
86. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 7# wufonna
­n¤F¸Ñºô­¶½s½X,¤~¯à±o¤ßÀ³¤â

1. Private Sub GetIncome() '¨ú·l¯qªí(¦~ªí)ºô­¶
   
2. Dim Url, HTMLsourcecode, GetXml, TableG, i, j
   
3. Set HTMLsourcecode = CreateObject("htmlfile")
   
4. Set GetXml = CreateObject("msxml2.xmlhttp")
   
5. Url = "http://kgieworld.moneydj.com/z/zc/zcq/zcqa/zcqa_2330.djhtm"
   
6. With GetXml
   
7. .Open "GET", Url, False
   
8. .Send
   
9. HTMLsourcecode.body.innerhtml = .Responsetext
   
10. Set TableG = HTMLsourcecode.getelementsbyclassname("table-row")
    
11. '***ºô­¶ªº½s½X**********************************
    
12. '<div class="table-row">   ¬°©Ò­nªº¸ê®Æ ªººô­¶¤¸¯À
    
13. '<span class="t2 table-cell">´Á§O</span>
    
14. '<span class="t2 table-cell">2020</span>
    
15. '<span class="t2 table-cell">2019</span>
    
16. '<span class="t2 table-cell">2018</span>
    
17. '<span class="t2 table-cell">2017</span>
    
18. '<span class="t2 table-cell">2016</span>
    
19. '<span class="t2 table-cell">2015</span>
    
20. '<span class="t2 table-cell">2014</span>
    
21. '<span class="t2 table-cell">2013</span>
    
22. '</div>************************************
    
23. For i = 0 To TableG.Length - 1
    
24.     For j = 0 To TableG(i).all.tags("span").Length - 1
    
25.        Cells(i + 1, j + 1) = TableG(i).all.tags("span")(j).innertext
    
26.     Next j
    
27. Next i
    
28. End With
    
29. Set HTMLsourcecode = Nothing 'ÄÀ©ñ°O¾ÐÅé
    
30. Set GetXml = Nothing
    
31. End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

½Æ»s¥N½X

ROE=·l¯qªí-µ|«e²b§Q(67)/¸ê²£­t¶ÅªíªÑ-ªFÅv¯qÁ`ÃB(95)
.Cells(i, 9).Value = ¤u§@ªí4.Cells(67, 2).Value / ¤u§@ªí5.Cells(95, 2).Value 'ROE%
#11 ªº°ÝÃD³o¤½¦¡À³¥i¸Ñ¨M

wufonna

1. '          .Cells(i, 9).Value = ¤u§@ªí4.Cells(67, 2).Value / ¤u§@ªí5.Cells(95, 2).Value 'ROE%
   
2.            .Cells(i, 9).Value = ¤u§@ªí4.Range("b" & ¤u§@ªí4.Columns("A").Find("µ|«e²b§Q").Row).Value / ¤u§@ªí5.Range("b" & ¤u§@ªí5.Columns("A").Find("ªÑªFÅv¯qÁ`ÃB").Row).Value 'ROE% ¤£©T©w¦ì¤l

½Æ»s¥N½X

¦^´_ 1# wufonna

­×¸Ó¤ù¬q

wufonna

¦^´_ 1# wufonna

1. Sub test()
   
2. Debug.Print "test"
   
3. 
   
4. 
   
5. With Sheet1
   
6.   Debug.Print .Columns("A").Find("µ|«e²b§Q").Row
   
7.   Debug.Print .Range("b" & Sheet1.Columns("A").Find("µ|«e²b§Q").Row).Value
   
8.   
   
9.   Debug.Print .Rows("67").Find(-336).Column
   
10.   Debug.Print .Rows("67").Find("-336").Column
    
11.   Debug.Print .Rows("67").Find("52").Column
    
12.             
    
13.   Debug.Print .Rows("67").Find(0).Column '§ä¨ì101¤ºªº0
    
14. 
    
15. End With
    
16. 
    
17. End Sub

½Æ»s¥N½X

¬ö¿ý¤@¤U

wufonna

¦^´_ 1# wufonna

ª÷¿Ä«OÀI·~ §O ªºªí®æ®æ¦¡¤£¤@¼Ë §ì¤£¨ì¥¿½Tªº¸ê®Æ
§Ú¬O¨ú
ROE=·l¯qªí-µ|«e²b§Q(67)/¸ê²£­t¶ÅªíªÑ-ªFÅv¯qÁ`ÃB(95)
.Cells(i, 9).Value = ¤u§@ªí4.Cells(67, 2).Value / ¤u§@ªí5.Cells(95, 2).Value 'ROE%
¨D§ï¥¿¤èªk ÁÂÁÂ

ªþÀɬO§ì¨ìªº¸ê®Æ

wufonna

¦^´_ 1# wufonna
ÁÂÁ ¤j¤j §ï¦n¤F

wufonna

¦^´_ 8# quickfixer


   §ä¨ì¤F  ÁÂÁ ¤j¤j  §Ú¦b¸Õ¬Ý¬Ý

quickfixer

¦^´_ 7# wufonna


    f3202¤j¤j,¦b 2019-6-18 07:55  #11 µ¹§Aªº01ºô§}
¥hºô§}¸Ì­±ªº2021-12-24 18:11 #1173 ªº¤å³¹copy:@

wufonna

1. Private Sub GetIncome(ByVal ss As String) '¨ú·l¯qªí(¦~ªí)ºô­¶
   
2. Dim Url, HTMLsourcecode, GetXml, TableG, i, j
   
3. Set HTMLsourcecode = CreateObject("htmlfile")
   
4. Set GetXml = CreateObject("msxml2.xmlhttp")
   
5. Url = "http://kgieworld.moneydj.com/z/zc/zcq/zcqa/zcqa_" & ss & ".djhtm"
   
6. With GetXml
   
7. .Open "GET", Url, False
   
8. .Send
   
9. 
   
10. HTMLsourcecode.body.innerhtml = .Responsetext
    
11. Set TableG = HTMLsourcecode.all.tags("table")(2).Rows
    
12. For i = 0 To TableG.Length - 1
    
13. For j = 0 To TableG(i).Cells.Length - 1
    
14. ¤u§@ªí4.Cells(i + 1, j + 1) = TableG(i).Cells(j).innertext
    
15. Next j
    
16. Next i
    
17. End With
    
18. Set HTMLsourcecode = Nothing 'ÄÀ©ñ°O¾ÐÅé
    
19. Set GetXml = Nothing
    
20. End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

½Æ»s¥N½X

¤§«eªº®»¤£¨ì

wufonna

¦^´_ 3# quickfixer
½Ð¤j¤j ¥i¥H¶K¤Wµ{¦¡¶Ü¡H
§Ú&#162174;¤£¨ì 01 ===>>> #1173
ÁÂÁÂ