[µo°Ý] [¨D§U]¸ê®Æ¬d¸ß¨S¦³¦^À³

herhsiu

¦¹ÀɬO±q¶°«O¤¤¤ß¬d¸ßªÑÅv¤À´²ªí,¥Øªº¬O­n§âªÑÅv¦³¶°¤¤ªº­ÓªÑµ¹¿z¿ï¥X¨Ó,¥i¬Oµ{¦¡°õ¦æ¤@¬q®É¶¡«á³£·|¨S¦³¦^À³,¨S¦³¿ìªk¶¶§Q¶]§¹,½Ð±Ð¥ý¶i¸Ó¦p¦ó­×¥¿?·P¿E¤£ºÉ~

Query.zip (76.75 KB)

¤U¸ü¦¸¼Æ: 28

2013-10-1 10:28

cji3cj6xu6

¨þ¨þ~
ªGµMÁÙ¬OG¤j¤ñ¸û±M·~~

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

cji3cj6xu6

sheet1 ¦s©ñ¤@¦~ªºªÑÅvÅÜ´«¸ê®Æ
sheet2 ¦s©ñ¤@¦~ªºªÑÅv¦³®Ä¤é´Á
sheet3 §ì¤U¨C¤ëªÑÅvªºªÑÅvÅÜ´«¸ê®Æ¨Ã¦s©ñ¨ìsheet1
sheet4 ªÑ²¼¥N¸¹¡A©¡®É³o¸Ì¬O¥i¥HÅܼƤ覡¨Ó§ì¨ú·QÆ[¹îªºªÑÅvÅÜ´«¸ê®Æ

©ó¬O±NG¤jªº®æ¦¡­×§ï¦p¤U¡G

1. Sub ¶°«O¤áªÑÅv¤À´²ªí¬d¸ß_WEB()
   
2.     Dim Ar(), A, i As Integer, strDate As String, stkno As String, Qur As String
   
3.     With CreateObject("InternetExplorer.Application")
   
4.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
   
5.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
   
6.         Set A = .document.All.tags("option") '¸ê®Æ¤é´Áªº¤º®e
   
7.         ReDim Ar(A.Length - 1)
   
8.         For i = 0 To A.Length - 1
   
9.             Ar(i) = A(i).innerHTML
   
10.             If InStr(Ar(i), Format(Date, "YYYYMM")) Then strDate = Ar(i) '¾É¤J·í¤ë¤é´Á
    
11.         Next
    
12.         .Quit
    
13.     End With
    
14.    
    
15.     For DQ = 1 To 3
    
16.     Sheets(DQ).Select
    
17.     Cells.Clear
    
18.     Next DQ
    
19.         
    
20.     For i = 1 To 12
    
21.     Sheets(2).Select
    
22.     Range("a" & i + 1).Value = Ar(i)
    
23.     Next i
    
24.    
    
25.     Range("a" & 14).Value = Ar
    
26.    
    
27.     With Worksheets(2)              'sorting
    
28.       Range("A1:ac20").Sort _
    
29.       Key1:=.Range("a1"), _
    
30.       Order1:=xlDescending, _
    
31.       Header:=xlYes, _
    
32.       Orientation:=xlTopToBottom
    
33.     End With
    
34. 'End Sub
    
35.    
    
36.     TotalDate2 = 1
    
37.             
    
38.     For Totaldate = 2 To 14
    
39.     'Do
    
40.     '    strDate = InputBox(Join(Ar, vbTab), "¶°«O¤áªÑÅv¤À´²ªí¬d¸ß ¤§ ¦³®Ä¤é´Á", strDate)
    
41.      strDate = Sheets(2).Range("a" & Totaldate)
    
42.     '    If strDate = "" Then Exit Sub
    
43.      
    
44.     'Loop Until IsNumeric(Application.Match(strDate, Ar, 0))
    
45.    
    
46.     stkno = Sheets(4).Range("a1")    '
    
47.    
    
48.     If stkno = "" Then Exit Sub
    
49.     Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
    
50.     If Sheets(3).QueryTables.Count = 0 Then
    
51.         Sheets(3).QueryTables.Add "URL;" & Qur, Sheets(3).[A1]
    
52.     Else
    
53.         Sheets(3).QueryTables(1).Connection = "URL;" & Qur
    
54.     End If
    
55.     With Sheets(3).QueryTables(1)
    
56.         .Name = "«ùªÑ¤À§G"
    
57.         .FieldNames = True
    
58.         .RowNumbers = False
    
59.         .FillAdjacentFormulas = False
    
60.         .PreserveFormatting = False
    
61.         .RefreshOnFileOpen = False
    
62.         .BackgroundQuery = True
    
63.         .RefreshStyle = xlOverwriteCells
    
64.         .SavePassword = False
    
65.         .SaveData = True
    
66.         .AdjustColumnWidth = False
    
67.         .RefreshPeriod = 0
    
68.         .WebSelectionType = xlSpecifiedTables
    
69.         .WebFormatting = xlWebFormattingNone
    
70.         .WebTables = "6,7,8"
    
71.         .WebPreFormattedTextToColumns = True
    
72.         .WebConsecutiveDelimitersAsOne = True
    
73.         .WebSingleBlockTextImport = False
    
74.         .WebDisableDateRecognition = False
    
75.         .WebDisableRedirections = False
    
76.         .Refresh BackgroundQuery:=False
    
77.     End With
    
78.    
    
79.     Worksheets(3).Select                       '¦¬¶°¸ê®Æ¨ìsheet1
    
80.     Range("a3:e21").Select
    
81.     Application.CutCopyMode = False
    
82.     Selection.Copy
    
83.    
    
84.    
    
85.     Worksheets(1).Select
    
86.     Range("a" & TotalDate2).Select
    
87.     ActiveSheet.Paste
    
88.     TotalDate2 = TotalDate2 + 20
    
89.    
    
90.     Next Totaldate
    
91. End Sub

½Æ»s¥N½X

GBKEE

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

cji3cj6xu6

§Ú·d©w¤F¡C
Thanks.

cji3cj6xu6

ÁÂÁÂGBKEE ¤j¡A

¦ý½Ð°Ý¤@¤U¡A¦p¦ó§ì¤U"¶°«O¤áªÑÅv¤À´²ªí¬d¸ß ¤§ ¦³®Ä¤é´Á"
°²³]§Ú·Q±N¥L¦s¨ìSheet1 "A1 ~ A10"

ÁÂÁ¡I

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

cji3cj6xu6

§Aªº²{¶H§Ú¹J¹L¡A
«Øij§A±NªÑ²¼¥N¸¹±a¶i¥h­ì©lÀɤ¤¡A
·í­ì©lÀɦb§ì¨ú¨CÀɪѲ¼¸ê®Æ®É¡A¶ë¶i¥h1 or 2 ¬íÄÁ¡A
¦A±N§A­nªº¸ê®Æ§ì¥X¨Ó¡C

¦p¦¹À³¸Ó¥i¦æ¡ã

herhsiu

¦^´_ 5# GBKEE

GBKEE¤j¤j,µ{¦¡­×§ï«á¸ê®Æ¬d¸ß¸I¨ì¨S¦³¸ê®Æªº¤é´Á(5/1³Ò°Ê¸`)·|¥X²{¿ù»~¤¤Â_,­ì¥»ªºcode«o¤£·|¦³³oºØ±¡ªp,½Ð°Ý¸Ó¦p¦ó¸Ñ¨M?ÁÂÁÂ~



    Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
   
       If Sheet3.QueryTables.Count = 0 Then
            Sheet3.QueryTables.Add "URL;" & Qur, Sheet3.[A3]
            Else
                Sheet3.QueryTables(1).Connection = "URL;" & Qur
                Msg = True
       End If

         With Sheet3.QueryTables(1)
             .Name = "«ùªÑ¤À§G"
             .FieldNames = True
             .RowNumbers = False
             .FillAdjacentFormulas = False
             .PreserveFormatting = False
             .RefreshOnFileOpen = False
             .BackgroundQuery = True
             .RefreshStyle = xlOverwriteCells
             .SavePassword = False
             .SaveData = True
             .AdjustColumnWidth = False
             .RefreshPeriod = 0
             .WebSelectionType = xlSpecifiedTables
             .WebFormatting = xlWebFormattingNone
             .WebTables = "6,7,8"
             .WebPreFormattedTextToColumns = True
             .WebConsecutiveDelimitersAsOne = True
             .WebSingleBlockTextImport = False
             .WebDisableDateRecognition = False
             .WebDisableRedirections = False
             .Refresh BackgroundQuery:=False
         End With