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

作者: chungyuandye (養花種魚數月亮看星星) 看板: Office
標題: Re: [問題] 其實我的問題 跟 6625 一樣
時間: Fri Aug 15 23:41:26 2008

※ 引述《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 處理喔
: 因為 資料 近上萬筆吧
: 感謝

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

--
我打研究室走過 那獨坐電腦前的容顏如苦瓜的糾結
靈感不來 長壽的煙霧不散
研究室如小小的寂寞的城 恰如商管的電梯向晚

http://chungyuandye.blogspot.com

--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 218.171.170.103
推 sunfox:感謝讓我遇見這位神奇的大大  08/16 08:08
推 JieJuen:話說網站改版了...  09/27 01:42