[算表] 網頁資料擷取到Excel中

[sunfox (每天都想怎麼賺錢)]

您所使用的軟體為: Excel 2003
版本: OFFICE 2003

各位先進  以下 有 5筆 資料

www.doh.gov.tw/DOHS/MDMAGBAS_data.aspx?id=2501150010&select_type=mdmagbas
www.doh.gov.tw/DOHS/MDMAGBAS_data.aspx?id=3501150020&select_type=mdmagbas
www.doh.gov.tw/DOHS/MDMAGBAS_data.aspx?id=3501150039&select_type=mdmagbas
www.doh.gov.tw/DOHS/MDMAGBAS_data.aspx?id=3501150048&select_type=mdmagbas
www.doh.gov.tw/DOHS/MDMAGBAS_data.aspx?id=3501150057&select_type=mdmagbas

點進去之後

會出現 制式的表格

有機構名稱  有負責人  有電話  有地址  ............

基本上  我只需要 上面這是種資料

有辦法 用 EXCEL 去 讀出來嗎  且以下資料型態 呈現

├───┼────┼───┼───┼───┼───┼───┼───┼───┤
│負責人│ 機構   │ 電話 │  地址│      │      │      │      │      │
├───┼────┼───┼───┼───┼───┼───┼───┼───┤
│小叮噹│大雄之家│ 123  │ JP   │      │      │      │      │      │
├───┼────┼───┼───┼───┼───┼───┼───┼───┤
│小叮玲│未來某處│ 456  │ fu   │      │      │      │      │      │


不知道 有沒有辦法用 EXCEL 處理喔

因為 資料 近上萬筆吧

感謝


--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 61.62.129.225
推 hedonic:寫程式去撈
> -------------------------------------------------------------------------- <

作者: chungyuandye (養花種魚數月亮看星星) 看板: Office

http://www.doh.gov.tw/DOHS/

上面的網址依照機構，縣市，鄉鎮先將機構代碼帶出，將這些資料複製到excel
的temp工作表，以下vba程式碼會將機構名稱，負責人，電話及地址複製到sheet2

Sub ptt()
Sheets("Sheet1").Select
For i = 1 To 10
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.doh.gov.tw/DOHS/turnpage.aspx?id=" & Sheets("temp").Cells(i, 1) & "&select_type=MDMAGBAS" _
        , Destination:=Sheets("Sheet1").Range("A1"))
        .Name = "醫事機構開業登記資料查詢"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "4"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Sheets("sheet2").Cells(i + 1, 1) = Cells(4, 2)
    Sheets("sheet2").Cells(i + 1, 2) = Sheets("temp").Cells(i, 2)
    Sheets("sheet2").Cells(i + 1, 3) = Cells(5, 2)
    Sheets("sheet2").Cells(i + 1, 4) = Cells(6, 2)
    ActiveSheet.Range("A:D").Delete
Next
End Sub

--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 218.171.170.103
推 sunfox:感謝讓我遇見這位神奇的大大
推 JieJuen:話說網站改版了...
註:網站已改版，此巨集可能不能再用，但仍可參考應用之
※ 重新編輯: JieJuen (09/30/2008)