返回列表 上一主題 發帖

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

回復 1# yanto913
此網址 https://sites.google.com/site/yanto913/data/Question.htm 須下載到你的電腦中存為 Question.htm
下列程序會將Question.htm 的資料下載到活頁簿作用中的工作表
  1. Sub Ex()
  2. Dim ie As New InternetExplorer, Rng As Range, i, ii, s
  3. Set Rng = ActiveSheet.[A1]
  4. With ie
  5. .Navigate ("D:\TEST\Question.htm")  '下載到你的電腦中存為 Question.htm
  6. For i = 0 To .Document.all.Length - 1
  7. If .Document.all(i).tagName = "TD" Then
  8. Rng.Value = .Document.all(i).innerText
  9. If .Document.all(i).innerText = "評語" Then
  10. Set Rng = ActiveSheet.[A2]
  11. Else
  12. Set Rng = Rng.Offset(, 1)
  13. End If
  14. End If
  15. If .Document.all(i).tagName = "A" Then
  16. If .Document.all(i).Title Like "*國文*" Then
  17. s = Split(.Document.all(i).Title, Chr(10))
  18. For ii = 0 To UBound(s) - 1
  19. ActiveSheet.Cells(1, 5 + ii).Resize(2) = Application.Transpose(Split(s(ii), ":"))
  20. Next
  21. End If
  22. End If
  23. Next
  24. .Quit
  25. End With
  26. End Sub
複製代碼

TOP

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

TOP

回復 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

TOP

        靜思自在 : 人的眼睛長在前面,只看到別人的缺點,絲毫看不到自己的缺點。
返回列表 上一主題