[分享] (已解決)請問將網址用WORD開啟後，應如何寫巨集複製到EXCEL表格中呢!?

fusayloveme

小弟一開始嘗試利用巨集錄製，發現好像巨集不管我是否有開啟WORD，所以有些問題想請教版上大大

下載 (155.77 KB)

2012-2-20 14:43

一開始利用EXCEL建立需要開啟的網址後，複製到WORD開啟後，

下載 (287.54 KB)

2012-2-20 14:43

大概就像類似以上的畫面，"貼上的位置"是指我在WORD複製後，要貼上的所在欄位，
接下來，我需要將部分文字做一個"轉置的動作"，然後在行貼上我的欄位，不過由於資料龐大，
不曉得版上大大是否有更好的辦法，小弟感激不盡!! 謝謝
附上EXCEL檔
感謝!!
草種_試試看.rar (127.71 KB)

下載次數: 5

2012-2-20 14:50

fusayloveme

回復 9# Hsieh

http://toxiceric.epa.gov.tw/edm/oldepaper.aspx
環境毒災簡訊電子報網站~感激不盡!

Hsieh

回復 8# fusayloveme


    擷取網頁內容，必須看網頁的結構
不同網頁有不同方法，並非所有網頁都能這樣容易擷取資料
況且對於網管較嚴的網站，這樣的作法可能被認為是砍站軟體而被封鎖
，請附上網址以利測試

fusayloveme

回復 6# Hsieh

Hsieh大，您好，利用日前您教我的方法嘗試去抓出網頁上的內容，但發現若是像是電子報此類的格式，
較少相關定義表格，若我想將電子報的內容，依照我想要大標題擷取，請問比較好的做法是? 感激不盡!

附件內容格式會再依照所需內容進行刪減，主要是先將主要的內容分別摘出，以利進行編輯，感激!

災害.rar (12.93 KB)

下載次數: 6

2012-2-24 09:13

fusayloveme

回復 6# Hsieh

感謝~一目了然，萬分感謝Hsieh大大的指導 ^_^

Hsieh

回復 5# fusayloveme


    Sub nn()
Dim MyIE As InternetExplorer, MyDoc As HTMLDocument
Set MyIE = CreateObject("InternetExplorer.application")
Set d = CreateObject("Scripting.Dictionary")
With MyIE
.Visible = True
r = 3
For i = 1 To 1044
.navigate "http://www.tbs-aqua.com/encyclopaedia/plant?plantID=" & i  '網址
Do Until .readyState = READYSTATE_COMPLETE: Loop  '直到網頁下載完成
Set MyDoc = .document  '設定網頁中的文件給變數
   With MyDoc  '網頁中的文件敘述區段
     Set x = .getElementsByTagName("Table")  '取得文件中所有表格
     For j = 0 To x(9).Cells.Length - 1 Step 2  '在第10個表格中所有格子做迴圈，一次跳2格
     n = Replace(Replace(x(9).Cells(j).innerText, "：", ""), " ", "")  '取奇數格的內容去冒號與空格
        d(n) = x(9).Cells(j + 1).innerText  '以奇數格內文字做索引紀錄偶數格的內容
     Next
     d("性狀") = x(10).innerText  '第11個表格內容為性狀
   End With
   With Sheet1
     .Cells(r, 1) = i  'A欄寫入編號
     For k = 2 To 11
     n = .Cells(2, k).Value  '從B欄開始寫入對應的內容
       .Cells(r, k) = d(n)
     Next
     r = r + 1
    End With
     d.RemoveAll   '移除字典物件內容
Next
.Quit  '關閉IE瀏覽器
End With
End Sub

fusayloveme

回復 4# Hsieh

真是太感謝Hsieh大了，可以使用，但我想請教一下，觀察一下代碼，似乎是不需要指定 HTMLDocument 裡面的相關位置，

反而好像是直接指定EXCEL中的欄位，我想問一下，這如何辦到的!? 感激不盡! 萬分感謝!!

Hsieh

回復 3# fusayloveme
忘記提醒要設定引用項目
Microsoft HTML Object Library
Microsoft Internet Controls

下載 (18.45 KB)

2012-2-20 21:38

程式是直接開啟每個植物介紹網頁
然後擷取其中需要的表格資料
不須經過其他程式轉載
重點在於標題要先輸入好
然後會依照植物編號由1開始下載資料填入工作表

fusayloveme

回復 2# Hsieh

不好意思,Hsieh大大,嘗試將您的代碼代入後，發現"使用者自訂型態尚未定義"，第一次碰到如此情形，請問該如何解決呢?

另外想請問大大，由於網站不能複製，所以我需要將網址貼在WORD"開啟舊檔"的路徑中，由WORD開啟，

但我看了一下代碼似乎好像還是以IE為主，請問我能夠改成 MyIE As Microsoft Office Word 2007 嗎?

但由於是必須從 WORD中的開啟舊檔中開啟，想請問大大，這樣是否能夠行的通呢!? 感激不盡!!

Hsieh

回復 1# fusayloveme
第二列標題已先輸入

1. Sub nn()
   
2. Dim MyIE As InternetExplorer, MyDoc As HTMLDocument
   
3. Set MyIE = CreateObject("InternetExplorer.application")
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. With MyIE
   
6. .Visible = True
   
7. r = 3
   
8. For i = 1 To 1044
   
9. .navigate "http://www.tbs-aqua.com/encyclopaedia/plant?plantID=" & i
   
10. Do Until .readyState = READYSTATE_COMPLETE: Loop
    
11. Set MyDoc = .document
    
12.    With MyDoc
    
13.      Set x = .getElementsByTagName("Table")
    
14.      For j = 0 To x(9).Cells.Length - 1 Step 2
    
15.      n = Replace(Replace(x(9).Cells(j).innerText, "：", ""), " ", "")
    
16.         d(n) = x(9).Cells(j + 1).innerText
    
17.      Next
    
18.      d("性狀") = x(10).innerText
    
19.    End With
    
20.    With Sheet1
    
21.      .Cells(r, 1) = i
    
22.      For k = 2 To 11
    
23.      n = .Cells(2, k).Value
    
24.        .Cells(r, k) = d(n)
    
25.      Next
    
26.      r = r + 1
    
27.     End With
    
28.      d.RemoveAll
    
29. Next
    
30. .Quit
    
31. End With
    
32. End Sub

複製代碼