GBKEE

¦^´_ 4# herhsiu

¤U¸ü (48.16 KB)

2013-10-2 15:42

¦³¿ìªk±N¨C¤é¸ê®Æ·|¦¨¤@¥÷

1.     If .QueryTables.Count = 0 Then
   
2. 29.                .QueryTables.Add "URL;" & Qur, .[A1]
   
3. 30.            Else
   
4. 31.                .QueryTables(1).Connection = "URL;" & Qur
   
5. 32.                Msg = True
   
6. 33.            End If
   
7. 34.           With .QueryTables(1)

½Æ»s¥N½X

¦^´_ 3# luhpro
·j¹M¾ã­Ó±M®×³£¨S¬Ý¨ì©I¥s Trans2Mon ¥\¯àªº±Ô­z,¦b³o¸Ì

¤U¸ü (40.43 KB)

2013-10-2 15:50

GBKEE

¦^´_ 9# herhsiu
¨S¬Ý¨ì§Aªº¦^ÂÐ,¤£¦n·N«ä,¿ð¦Ü¤µ¤é¤~¦^ÂÐ
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub ¶°«O¤áªÑÅv¤À´²ªí¬d¸ß_WEB()
   
3.     Dim Ar(), A, i As Integer, strDate As String, stkno As String, Qur As String
   
4.     With CreateObject("InternetExplorer.Application")
   
5.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
   
6.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
   
7.         Set A = .document.All.tags("option") '¸ê®Æ¤é´Áªº¤º®e
   
8.         ReDim Ar(A.Length - 1)
   
9.         For i = 0 To A.Length - 1
   
10.             Ar(i) = A(i).innerHTML
    
11.         Next
    
12.         .Quit
    
13.     End With
    
14.     strDate = Ar(0) '¾É¤J·í¤ë¤é´Á
    
15.     Do
    
16.         strDate = InputBox(Join(Ar, vbTab), "¶°«O¤áªÑÅv¤À´²ªí¬d¸ß ¤§ ¦³®Ä¤é´Á", strDate)
    
17.         If strDate = "" Then Exit Sub
    
18.      
    
19.     Loop Until IsNumeric(Application.Match(strDate, Ar, 0))
    
20.     stkno = InputBox("¿é¤JªÑ²¼¥N¸¹", "ªÑ²¼¥N¸¹", 2317)    '
    
21.     If stkno = "" Then Exit Sub
    
22.     Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
    
23.     With ActiveSheet
    
24.         If .QueryTables.Count = 0 Then
    
25.             .QueryTables.Add "URL;" & Qur, .[A1]
    
26.         Else
    
27.             .QueryTables(1).Connection = "URL;" & Qur
    
28.         End If
    
29.         With .QueryTables(1)
    
30.             .WebSelectionType = xlSpecifiedTables
    
31.             .WebFormatting = xlWebFormattingNone
    
32.             .WebTables = "6,7,8"
    
33.             .WebPreFormattedTextToColumns = True
    
34.             .WebConsecutiveDelimitersAsOne = True
    
35.             .WebSingleBlockTextImport = False
    
36.             .WebDisableDateRecognition = False
    
37.             .WebDisableRedirections = False
    
38.             .Refresh BackgroundQuery:=False
    
39.         End With
    
40.     End With
    
41. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 13# cji3cj6xu6
·d©w¤F,­n¤À¨É¤@¤U

GBKEE

¦^´_ 15# cji3cj6xu6
§ì¤U¨C¤ëªÑÅvªºªÑÅvÅÜ´«¸ê®Æª½±µ©ñ¨ìSheets(1)

1. Option Explicit
   
2. Sub ¶°«O¤áªÑÅv¤À´²ªí¬d¸ß_WEB()
   
3.     Dim Ar(), A, i As Integer, strDate As String, stkno As String, Qur As String, e As Variant
   
4.     With CreateObject("InternetExplorer.Application")
   
5.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
   
6.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
   
7.         Set A = .document.All.tags("option") '¸ê®Æ¤é´Áªº¤º®e
   
8.         ReDim Ar(A.Length - 1)
   
9.         For i = 0 To A.Length - 1
   
10.             Ar(i) = A(i).innerHTML
    
11.         Next
    
12.         .Quit
    
13.     End With
    
14.     stkno = Sheets(4).Range("a1")
    
15.     If stkno = "" Then Exit Sub
    
16.     With Sheets(1)
    
17.         .Cells.Clear
    
18.         For Each e In .Names
    
19.             e.Delete          '§R±¼QueryTableªº¦WºÙ
    
20.         Next
    
21.         For i = 0 To UBound(Ar)
    
22.             strDate = Ar(i)   '¶°«O¤áªÑÅv¤À´²ªí¬d¸ß ¤§ ¦³®Ä¤é´Á"
    
23.         Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
    
24.         With .QueryTables.Add("URL;" & Qur, .Cells(.Range("B" & Rows.Count).End(xlUp).Row + 1, 1))
    
25.         .WebSelectionType = xlSpecifiedTables
    
26.         .WebFormatting = xlWebFormattingNone
    
27.         .WebTables = "6,7,8"
    
28.         .Refresh BackgroundQuery:=False
    
29.         If i = 0 Then
    
30.            .ResultRange.Range("2:2,4:4").Delete  'QueryTable:ªÅ¥Õ¦C
    
31.         ElseIf i > 0 Then
    
32.         .ResultRange.Range("1:2,4:4").Delete     'QueryTable: "Áp¹qªÑ¥÷¦³­­¤½¥q ¶°«O¤áªÑÅv¤À´²ªí"&ªÅ¥Õ¦C
    
33.         End If
    
34.         End With
    
35.         Next
    
36.         .Rows(1).Delete     'Sheets(1)²Ä1¦C
    
37.     End With
    
38. End Sub

½Æ»s¥N½X