GBKEE

¦^´_ 1# fusayloveme
¶×¤J104 ¦¸ ¤Ó¤[¤F, §ä§ä¬Ý­þ¸Ì¦³¥i¥H¤@¦¸¶×¤Jªº¸ê®Æ.
¥H¤Uµ{¦¡¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim xi, q  As QueryTable, i As Integer, Rng As Range
   
4.     Sheets("¬ö¿ý").Cells.Clear       '"¬ö¿ý"     ¤u§@ªí
   
5.     With Sheets("Sheet1")            '"Sheet1" ¤u§@ªí
   
6.         .Cells.Clear
   
7.         For Each q In .QueryTables
   
8.             q.Delete                 '²M°£¥~³¡¬d¸ß
   
9.         Next
   
10.         With .QueryTables.Add("URL;http://www.l-zzz.com/shiyou/sy_list.jsp?nID=46", .[a1])
    
11.             .WebSelectionType = xlSpecifiedTables
    
12.             .WebFormatting = xlWebFormattingNone
    
13.             .WebTables = "17"                                 '¨ú±o­¶¼Æ
    
14.             .WebPreFormattedTextToColumns = True
    
15.             .WebConsecutiveDelimitersAsOne = True
    
16.             .WebSingleBlockTextImport = False
    
17.             .WebDisableDateRecognition = False
    
18.             .WebDisableRedirections = False
    
19.             .Refresh BackgroundQuery:=False
    
20.         End With
    
21.         xi = InStr(.[a1], "/")                               '¦r¦ê:"¦@ 1859 ±ø¬ö¿ý    1/104" ´M§ä "/"¦ì¸m
    
22.         xi = Val(Mid(.[a1], xi + 1))                         'Âର¼Æ¦r               '                              '
    
23.         For i = xi To 1 Step -1
    
24.             With .QueryTables(1)
    
25.                 .Connection = "URL;http://www.l-zzz.com/shiyou/sy_list.jsp?nID=46&pageNum=" & i
    
26.                 .WebSelectionType = xlSpecifiedTables
    
27.                 .WebFormatting = xlWebFormattingNone
    
28.                 .WebTables = "16"                             '¸ê®Æ¦ì¸m
    
29.                 .WebPreFormattedTextToColumns = True
    
30.                 .WebConsecutiveDelimitersAsOne = True
    
31.                 .WebSingleBlockTextImport = False
    
32.                 .WebDisableDateRecognition = False
    
33.                 .WebDisableRedirections = False
    
34.                 .Refresh BackgroundQuery:=False
    
35.             End With
    
36.             If i > 1 Then
    
37.                 Set Rng = .QueryTables(1).ResultRange
    
38.                 Set Rng = Rng.Range(Rng.Cells(2, 1), Rng.Cells(Rng.Rows.Count, Rng.Columns.Count))
    
39.                 Rng.Copy                                        '¸ê®Æ½Æ»s
    
40.             Else
    
41.                 .QueryTables(1).ResultRange.Copy
    
42.             End If
    
43.             Sheets("¬ö¿ý").[a1].Insert Shift:=xlDown            '´¡¤J¸ê®Æ
    
44.         Next
    
45.     End With
    
46. End Sub

½Æ»s¥N½X