GBKEE

¦^´_ 16# cji3cj6xu6
¸Ô¬ÝÀɮפºªºµ{¦¡½X

    Tset.rar (215.91 KB)

¤U¸ü¦¸¼Æ: 118

2013-7-28 20:27

GBKEE

¦^´_ 20# norafang
§A­n¥ÎIE¶×¤J¥~³¡¸ê®Æ¬OµLªk¥Î¿ý»s,
¥\¯àªí«ü¥O:¸ê®Æ-> ¶×¤J¥~³¡¸ê®Æ,¥i¥H¥Î¿ý»s¤U¨Ó­×§ï
19#ªº°ÝÃD ­n¦h¬Ý¬ÝVBA»¡©úªº ¨ç¼Æ,¤èªk,³¯­z¦¡,ÄÝ©Ê.¨Ó¤F¸Ñ¥Îªk,¥i¦Ê¤Ø¬ñÀY,§óªñ¤@¨B.

1. Option Explicit
   
2. 'Const ³¯­z¦¡ «Å§i±`¼Æ , ¨ä­È¦p¦r­±©Ò¥Ü
   
3. Sub a()
   
4.     Dim x, ur As String
   
5.     x = "2022"
   
6.     Const url As String = "http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl_AAAA.asp.htm"
   
7.     MsgBox url
   
8.     ur = "http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl_" & x & ".asp.htm"
   
9.     MsgBox ur
   
10. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 22# norafang
VBAªº¸gÅç­È¤Ó¤Ö¤F,»Ý¦h­×·Ò 21# ªºµ{¦¡½X¬O¦b»¡©ú Const ³¯­z¦¡

1. Option Explicit
   
2. Sub Test()
   
3.     Dim x, ur As String, IE As Object
   
4.     x = Worksheets("sheet1").Range("a1")
   
5.   '  Const url As String = "http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl_AAAA.asp.htm"
   
6.    ' MsgBox url
   
7.     ur = "http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl_" & x & ".asp.htm"
   
8.    ' MsgBox ur
   
9.     Set IE = CreateObject("internetexplorer.application") '¨Ï¥Î¦¹¤è¦¡¥i¥H§K°£ "³]©w¤Þ¥Î¶µ¥Ø"
   
10.     With IE
    
11.         .Visible = False 'True¬°¶}±Òie, False¬°¤£¶}±Òie
    
12.         .Navigate ur
    
13.         Do While .ReadyState <> 4 'µ¥«Ýºô­¶¶}±Ò
    
14.             DoEvents
    
15.         Loop
    
16.         .ExecWB 17, 2 'Select All
    
17.         .ExecWB 12, 2 'Copy selection
    
18.         With Sheets("Sheet1")
    
19.              .Cells.Clear
    
20.             '.Cells.Select
    
21.             .Range("AA1").Activate
    
22.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
    
23.                 False, NoHTMLFormatting:=True
    
24.         End With
    
25.     End With
    
26.     Columns("A:B").Delete
    
27.     IE.Quit
    
28.     MsgBox "¸ê®Æ½Æ»sµ²§ô"
    
29. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 25# alantsai777
¹j 10 ¬í¦Û°Ê§ó·s ?? ³oºô­¶ ¶¡¹j 5 ¬í¦Û°Ê§ó·s!!
µ{¦¡½X½Æ»s¨ì¤@¯ë¼Ò²Õ

1. Option Explicit
   
2. Dim IE As Object
   
3. Sub Ex_°ò¥»¥«ªp³ø¾Éºô¯¸()
   
4.     Dim A As Object, xDate As Date, EDATE As Date
   
5.     Set IE = CreateObject("InternetExplorer.Application")
   
6.     With IE
   
7.        ' .Visible = True
   
8.         .Navigate "http://mis.twse.com.tw/stock/fibest.jsp?stock=3673"
   
9.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
   
10.     End With
    
11.     Ex_°Æµ{¦¡
    
12. End Sub
    
13. Private Sub Ex_°Æµ{¦¡()
    
14.     Dim A As Object, K As Integer, i As Integer, ii As Integer
    
15.     With IE
    
16.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
17.         Set A = .Document.getElementsByTagName("table")(1)
    
18.     End With
    
19.     With ActiveSheet    '¥i«ü©w¤u§@ªí
    
20.         .UsedRange.Clear
    
21.         K = 1
    
22.         For i = 0 To A.Rows.Length - 1
    
23.             For ii = 0 To A.Rows(i).Cells.Length - 1
    
24.                 .Cells(K, ii + 1) = A.Rows(i).Cells(ii).INNERTEXT
    
25.             Next
    
26.             K = K + 1
    
27.         Next
    
28.     End With
    
29.     If Time <= #1:30:00 PM# Then   '¦¬½L®É¶¡ ¦Û¦æ½Õ¾ã
    
30.         Application.OnTime Time + #12:00:05 AM#, "Ex_°Æµ{¦¡"  '¶¡¹j5¬í
    
31.     Else
    
32.         IE.Quit
    
33.     End If
    
34. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 28# aaron1059
¸Õ¸Õ¬Ý
À°§A§ä¥X¶Ç¦^´ÁÅv¸ê®Æªººô§}¤£¤@¼Ë.

1. Option Explicit
   
2. Sub Ex() 'Yahoo!©_¼¯ªÑ¥«--´ÁÅv
   
3.     Dim ie As Object, k As Integer, S As Integer, jj As Integer, i As Integer, AA As Object
   
4.     Set ie = CreateObject("InternetExplorer.Application")
   
5.     ie.Navigate "https://tw.screener.finance.yahoo.net/future/aa03?opmr=optionfull&opcm=WTFO&opym=201510&random=0.01296169775357775"
   
6.     ie.Visible = True
   
7.     Do While ie.Busy Or ie.ReadyState <> 4: DoEvents: Loop
   
8.     Set AA = ie.Document.getelementsbytagname("table")
   
9.     With Sheets(1)
   
10.         .Cells.Clear
    
11.         k = k + 1
    
12.         For S = 0 To AA.Length - 1                 '¤w§ä¥Xºô­¶ªºtable¤º®e¦b 5-7 ¤¤
    
13.             For i = 0 To AA(S).Rows.Length - 1                 '¸ê®Æªº¦C¦ì
    
14.                 For jj = 0 To AA(S).Rows(i).Cells.Length - 1   '¸ê®ÆªºÄæ¦ì
    
15.                     .Cells(k, jj + 1) = AA(S).Rows(i).Cells(jj).INNERTEXT
    
16.                 Next
    
17.                 k = k + 1
    
18.              Next
    
19.           Next
    
20.        End With
    
21.      ie.Quit
    
22. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 30# bioleon69

1. ''CreateObject("InternetExplorer.Application") »Ýµ¥­Ôºô­¶¤U¸ü§¹²¦³t«×¸ûºC
   
2. '°õ¦æ°j°éÅý¥¦¶]1500¦¸,¼K³t«×·|ºC³\¦h
   
3. Option Explicit
   
4. Sub ´ú¸Õ()
   
5.     Dim oXmlhttp As Object, oHtmldoc As Object, surl, E As Object
   
6.     Set oXmlhttp = CreateObject("msxml2.xmlhttp")
   
7.     Set oHtmldoc = CreateObject("htmlfile")
   
8.     surl = "http://norway.twsthr.info/StockHolders.aspx?stock=2330"
   
9.     With oXmlhttp
   
10.         .Open "Get", surl, False
    
11.         .Send
    
12.         oHtmldoc.write .responseText
    
13.     End With
    
14.     With oHtmldoc
    
15.         Set E = .all.tags("TABLE")(9)
    
16.     End With
    
17.     Application.ScreenUpdating = False
    
18.     Ex_°Æµ{¦¡ E
    
19.     Application.ScreenUpdating = True
    
20. End Sub
    
21. Private Sub Ex_°Æµ{¦¡(A As Object)
    
22.     Dim i As Integer, R As Integer, C As Integer
    
23.     With ActiveSheet    '¥i«ü©w¤u§@ªí
    
24.         .UsedRange.Clear
    
25.         For R = 0 To 2 * 5    'Ū¨ú5µ§¸ê®Æ ' Âù¼ÆªºA.Rows¬°ªÅ¥Õ¸ê®Æ
    
26.             If R <= 1 Or R > 2 And R Mod 2 = 1 Then '­ç°£ Âù¼ÆªºA.Rows
    
27.                 i = i + 1
    
28.                 For C = 2 To A.Rows(R).Cells.Length - 1
    
29.                     .Cells(i, C - 1) = A.Rows(R).Cells(C).innertext
    
30.                 Next
    
31.             End If
    
32.         Next
    
33.         With .UsedRange  ' CELL ¬°¾ã¤u§@ªíªºÀx¦s®æ ½d³ò¤j(¶O®É)
    
34.            ' .UsedRange ¤u§@ªí¦³¨Ï¥Î¨ìªºªºÀx¦s®æ ½d³ò¤p(¬Ù®É)
    
35.             .EntireRow.AutoFit
    
36.             .EntireColumn.AutoFit
    
37.         End With
    
38.     End With
    
39. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 33# bioleon69

¥i§ï¥Î·|¤J¥~³¡¸ê®Æ .QueryTables

1. Option Explicit
   
2. Sub Ex()
   
3.     With ActiveSheet.QueryTables.Add(Connection:="URL;http://mops.twse.com.tw/nas/t21/sii/t21sc03_106_3_0.html", Destination:=Range("A1"))
   
4.         .WebSelectionType = xlSpecifiedTables
   
5.         .WebFormatting = xlWebFormattingNone
   
6.         .WebTables = "4"
   
7.         .RefreshStyle = xlOverwriteCells
   
8.         .WebPreFormattedTextToColumns = True
   
9.         .WebConsecutiveDelimitersAsOne = True
   
10.         .WebSingleBlockTextImport = False
    
11.         .WebDisableDateRecognition = False
    
12.         .WebDisableRedirections = False
    
13.         .Refresh BackgroundQuery:=False
    
14.     End With
    
15. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 33# bioleon69

1. Option Explicit
   
2. Sub ´ú¸Õ()
   
3.     Dim oXmlhttp As Object, oHtmldoc As Object, surl, E As Object
   
4.     Set oXmlhttp = CreateObject("msxml2.xmlhttp")
   
5.     Set oHtmldoc = CreateObject("htmlfile")
   
6.     surl = "http://mops.twse.com.tw/nas/t21/sii/t21sc03_106_3_0.html"
   
7.     With oXmlhttp
   
8.         .Open "Get", surl, False
   
9.         .Send
   
10.         'oHtmldoc.write .responseText
    
11.         oHtmldoc.write BinToStr(.responseBody, "BIG5") 'ºô­¶½s½X "¤¤¤å"
    
12.     End With
    
13.     With oHtmldoc
    
14.         Set E = .all.tags("TABLE")(3)
    
15.     End With
    
16.     Application.ScreenUpdating = False
    
17.     Ex_°Æµ{¦¡ E
    
18.     Application.ScreenUpdating = True
    
19. End Sub
    
20. Private Sub Ex_°Æµ{¦¡(A As Object)
    
21.     Dim i As Integer, R As Integer, C As Integer
    
22.     With ActiveSheet    '¥i«ü©w¤u§@ªí
    
23.         .UsedRange.Clear
    
24.         For R = 0 To A.Rows.Length - 1
    
25.                 For C = 0 To A.Rows(R).Cells.Length - 1
    
26.                     .Cells(R + 1, C + 1) = A.Rows(R).Cells(C).innertext
    
27.                 Next
    
28.         Next
    
29.         With .UsedRange  ' CELL ¬°¾ã¤u§@ªíªºÀx¦s®æ ½d³ò¤j(¶O®É)
    
30.            ' .UsedRange ¤u§@ªí¦³¨Ï¥Î¨ìªºªºÀx¦s®æ ½d³ò¤p(¬Ù®É)
    
31.             .EntireRow.AutoFit
    
32.             .EntireColumn.AutoFit
    
33.         End With
    
34.     End With
    
35. End Sub
    
36. Function BinToStr(arrBin, strChrs) As String
    
37.     With CreateObject("ADODB.Stream")  '¤G¶i¦ì¤åÀÉ,¶Ç°e,Àx¦s
    
38.         .Type = 2
    
39.         .Open
    
40.         .Writetext arrBin
    
41.         .Position = 0
    
42.         .Charset = strChrs   '«ü©w½s½X
    
43.         BinToStr = .ReadText
    
44.         .Close
    
45.     End With
    
46. End Function

½Æ»s¥N½X

GBKEE

¦^´_ 38# bioleon69

³o¸Ì¬Ý¬Ý    µLªk¥Î¥~³¡¸ê®Æ¶×¤Jªººô¯¸¯à¥ÎVBAŪ¨ú¸ê®Æ¶Ü¡H

GBKEE

¦^´_ 40# bioleon69

1. Option Explicit
   
2. Sub test()
   
3. Dim Ie As Object, e As Object, R As Integer, C As Integer
   
4.     'Set Ie = CreateObject("InternetExplorer.Application")
   
5.     With CreateObject("InternetExplorer.Application")
   
6.          '.Visible = True
   
7.         .Navigate "http://mops.twse.com.tw/mops/web/t56sb21_q3"
   
8.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
   
9.        '**************************************
   
10.         With .Document.forms("form1")
    
11.             .typek.Value = "otc"
    
12.             .Year.Value = "105"
    
13.             .smonth.Value = "03"
    
14.             .emonth.Value = "04"
    
15.         End With
    
16.       ''******************************************
    
17.         For Each e In .Document.ALL.TAGS("input")
    
18.             If e.Type = "button" And e.Value = " ¬d¸ß " Then e.Click
    
19.         Next
    
20.         '*****************************************
    
21.         Do
    
22.             DoEvents
    
23.             Set e = .Document.ALL("TABLE01").ALL.TAGS("TABLE")(0)
    
24.         Loop Until Not e Is Nothing
    
25.         ¸ê®Æ¼g¤J e
    
26.             .Quit
    
27.     End With
    
28. End Sub
    
29. Sub Ex()
    
30.     With CreateObject("InternetExplorer.Application")
    
31.         .Navigate "http://mops.twse.com.tw/mops/web/t56sb21_q3?encodeURIComponent=1&run=Y&step=1&TYPEK=sii&year=105&smonth=01&emonth=02&sstep=1&firstin=true"
    
32.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
    
33.         ¸ê®Æ¼g¤J .Document.ALL("TABLE01").ALL.TAGS("TABLE")(0)
    
34.             .Quit
    
35.     End With
    
36. End Sub
    
37. Private Sub ¸ê®Æ¼g¤J(ByVal xTable As Object)
    
38.     Dim R As Integer, C As Integer
    
39.     With ActiveSheet
    
40.             .UsedRange.Clear
    
41.             Application.ScreenUpdating = False
    
42.             For R = 0 To xTable.Rows.Length - 1
    
43.                 For C = 0 To xTable.Rows(R).Cells.Length - 1
    
44.                     .Cells(R + 1, C + 1) = xTable.Rows(R).Cells(C).INNERTEXT
    
45.                 Next
    
46.             Next
    
47.              .UsedRange.WrapText = False
    
48.              Application.ScreenUpdating = True
    
49.     End With
    
50. End Sub

½Æ»s¥N½X