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

看板Office作者chungyuandye (養花種魚數月亮看星星)時間17年前 (2008/08/15 23:41)推噓2(2推 0噓 0→)

留言2則, 2人參與討論串2/2 (看更多)

※ 引述《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