[發問] 匯入外部資料的問題（資料被用標註的）

帖子: 116
主題: 29
精華: 0
積分: 232
點名: 0
作業系統: winXp
軟體版本: office 2003
閱讀權限: 20
性別: 女
來自: 台灣台中市
註冊時間: 2010-9-6
最後登錄: 2023-7-11

8^#

發表於 2010-11-11 12:12 | 只看該作者

謝謝版主的程式
之前比較忙沒仔細研讀其含意(只看懂一點點)
目前想把程式應用到工作中發現有其問題產生
https://sites.google.com/site/yanto913/home/page
是能否能只抓四年乙班(特)和四年丙班(特)內的資料(我記得office 2000匯入外部資料
可以規定要從第幾個Block開始擷取，此範例網頁是第二和第三Block），
或者能否利用註：導師王小明到返回置頂↑當作一個擷取的起始以及終了，
之前版主的程式應該是收尋從第幾格開始，但是會遇到四年甲班格數變動有可能有學生轉出或轉入導致會變成五列或七列，
以及一般班級表格內容都是8行，但是特殊班級表格會多一格關心度也就是9行，
另外我的註解其實是往下的不知道為什麼傳到我的網頁上就被刪除了，
所以另外上傳我原本的網頁檔給各位先進，希望能夠幫我解決這個惱人的問題

Q2.rar (1.57 KB)

YOYO

帖子: 116
主題: 29
精華: 0
積分: 232
點名: 0
作業系統: winXp
軟體版本: office 2003
閱讀權限: 20
性別: 女
來自: 台灣台中市
註冊時間: 2010-9-6
最後登錄: 2023-7-11

7^#

發表於 2010-10-11 23:10 | 只看該作者

謝謝版主，可以用了!!
但偶而會出現Automation 錯誤(如下圖)

YOYO

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

6^#

發表於 2010-10-11 09:10 | 只看該作者

回復 5# yanto913
https://sites.google.com/site/yanto913/home/page  可以直接下載了可是Ex 程序又要修改
會出現系統錯誤  加上下三列紅色的程式碼  修正
Sub Ex()
Dim ie As New InternetExplorer, Rng As Range, i, ii, s
Set Rng = ActiveSheet.[A1]
With ie
.Navigate ("https://sites.google.com/site/yanto913/home/page")
Do While .Busy = True
Loop
DoEvents
Set Rng = ActiveSheet.[A1]
For i = 0 To .Document.all.Length - 1
      If .Document.all(i).tagName = "TD" And Len(.Document.all(i).innerText) > 0 And Len(.Document.all(i).innerText) <= 20 Then
         Rng.Value = .Document.all(i).innerText
         If .Document.all(i).innerText = "評語" Then
            Set Rng = ActiveSheet.[A2]
         Else
            Set Rng = Rng.Offset(, 1)
         End If
      End If
      If .Document.all(i).tagName = "A" Then
         If .Document.all(i).Title Like "*國文*" Then
            s = Split(.Document.all(i).Title, " ")
            For ii = 0 To UBound(s)
                  ActiveSheet.Cells(1, 5 + ii).Resize(2) = Application.Transpose(Split(s(ii), "："))
            Next
         End If
      End If
Next
.Quit
End With
End Sub

帖子: 116
主題: 29
精華: 0
積分: 232
點名: 0
作業系統: winXp
軟體版本: office 2003
閱讀權限: 20
性別: 女
來自: 台灣台中市
註冊時間: 2010-9-6
最後登錄: 2023-7-11

5^#

發表於 2010-10-11 01:12 | 只看該作者

本帖最後由 yanto913 於 2010-10-11 01:14 編輯

抱歉造成版主的困擾！因為我做的那個網頁是放在檔案夾，
所以點的時候會變成下載，而不是開啟。
我換用網頁的方式，
https://sites.google.com/site/yanto913/home/page
可是我不知道為什麼傳到google網頁上它後面沒有檔案加副檔名page.html
然後我去找能放網頁的免費空間都找不太到，大部分都要付費的
所以先傳到我這個網頁空間，然後再用版主的程式測試
把("D:\TEST\Question.htm")改成("https://sites.google.com/site/yanto913/home/page")
可是會出現系統錯誤，在隨便找個奇摩新聞測試(後面有HTML名稱)的一樣也不行
然後我在GOOGLE找到兩篇文章，
請各位先進在GOOGLE貼上[摘取網頁資料 - getElementsByName]收尋後第一個網站就是了(怕被說盜連)

另外一篇是舊麻辣上面的(共三頁)
http://gb.twbts.com/index.php?PHPSESSID=arhg8hul1cucn9e1gega2m99j1&topic=11352.0

我試著去改這兩篇的程式可是弄了兩個多小時還是改不成功(功力不夠的是我啊！！)
所貼上來請各位先進幫忙，謝謝！

YOYO

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2010-10-10 16:59 | 只看該作者

回復 3# yanto913
唉沒辦法! 功力不夠啊!,從網頁抓下來的全是一堆亂碼,只有從網頁抓下來存檔後才有辦法不是亂碼.
此程式只適用此網頁的.並不是所有網頁都適用特殊的程序都要量身製作的.

帖子: 116
主題: 29
精華: 0
積分: 232
點名: 0
作業系統: winXp
軟體版本: office 2003
閱讀權限: 20
性別: 女
來自: 台灣台中市
註冊時間: 2010-9-6
最後登錄: 2023-7-11

3^#

發表於 2010-10-10 13:33 | 只看該作者

謝謝GBKEE 版主
註解一下，要去工具>設定引用項目> 把 Microsoft Internet Controls及Microsoft HTML Object Library打勾
不過還是要下載下來喔，因為我那個網頁是舉例的，實際上要分析的網頁變更速率還蠻快的
總不能要看的時候還要下載一次，因為我想能直接載入然後再加上迴圈達到即時更新的目的

YOYO

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2010-10-10 07:17 | 只看該作者

回復 1# yanto913
此網址 https://sites.google.com/site/yanto913/data/Question.htm 須下載到你的電腦中存為 Question.htm
下列程序會將Question.htm 的資料下載到活頁簿作用中的工作表

Sub Ex()
Dim ie As New InternetExplorer, Rng As Range, i, ii, s
Set Rng = ActiveSheet.[A1]
With ie
.Navigate ("D:\TEST\Question.htm") '下載到你的電腦中存為 Question.htm
For i = 0 To .Document.all.Length - 1
If .Document.all(i).tagName = "TD" Then
Rng.Value = .Document.all(i).innerText
If .Document.all(i).innerText = "評語" Then
Set Rng = ActiveSheet.[A2]
Else
Set Rng = Rng.Offset(, 1)
End If
End If
If .Document.all(i).tagName = "A" Then
If .Document.all(i).Title Like "*國文*" Then
s = Split(.Document.all(i).Title, Chr(10))
For ii = 0 To UBound(s) - 1
ActiveSheet.Cells(1, 5 + ii).Resize(2) = Application.Transpose(Split(s(ii), "："))
Next
End If
End If
Next
.Quit
End With
End Sub

複製代碼