| ©«¤l5923 ¥DÃD13 ºëµØ1 ¿n¤À5986 ÂI¦W0  §@·~¨t²Îwin10 ³nÅ骩¥»Office 2010 ¾\ŪÅv150 ©Ê§O¨k ¨Ó¦Û¥xÆW°ò¶© µù¥U®É¶¡2010-5-1 ³Ì«áµn¿ý2022-1-23 
         
 | 
                
| ¦^´_ 1# fusayloveme ¶×¤J104 ¦¸ ¤Ó¤[¤F, §ä§ä¬Ýþ¸Ì¦³¥i¥H¤@¦¸¶×¤Jªº¸ê®Æ.
 ¥H¤Uµ{¦¡¸Õ¸Õ¬Ý
 ½Æ»s¥N½XOption Explicit
Sub Ex()
    Dim xi, q  As QueryTable, i As Integer, Rng As Range
    Sheets("¬ö¿ý").Cells.Clear       '"¬ö¿ý"     ¤u§@ªí
    With Sheets("Sheet1")            '"Sheet1" ¤u§@ªí
        .Cells.Clear
        For Each q In .QueryTables
            q.Delete                 '²M°£¥~³¡¬d¸ß
        Next
        With .QueryTables.Add("URL;http://www.l-zzz.com/shiyou/sy_list.jsp?nID=46", .[a1])
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "17"                                 '¨ú±o¶¼Æ
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        xi = InStr(.[a1], "/")                               '¦r¦ê:"¦@ 1859 ±ø¬ö¿ý    1/104" ´M§ä "/"¦ì¸m
        xi = Val(Mid(.[a1], xi + 1))                         'Âର¼Æ¦r               '                              '
        For i = xi To 1 Step -1
            With .QueryTables(1)
                .Connection = "URL;http://www.l-zzz.com/shiyou/sy_list.jsp?nID=46&pageNum=" & i
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "16"                             '¸ê®Æ¦ì¸m
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            If i > 1 Then
                Set Rng = .QueryTables(1).ResultRange
                Set Rng = Rng.Range(Rng.Cells(2, 1), Rng.Cells(Rng.Rows.Count, Rng.Columns.Count))
                Rng.Copy                                        '¸ê®Æ½Æ»s
            Else
                .QueryTables(1).ResultRange.Copy
            End If
            Sheets("¬ö¿ý").[a1].Insert Shift:=xlDown            '´¡¤J¸ê®Æ
        Next
    End With
End Sub
 | 
 |