[發問] 請問-抓取網站資料OPEC原油(中塑資訊網)

本帖最後由 GBKEE 於 2012-6-27 20:13 編輯

請問版上神人大大們，能否抓取http://www.l-zzz.com/shiyou/sy_list.jsp?nID=46，此網站內的"OPEC原油"的資料，
因為若從2005年開始抓，高達104頁，能否利用巨集抓取想要的資料。

附上之前我發問的資料(http://forum.twbts.com/thread-5888-1-1.html)，嘗試多次均無反應，渴望版上神人能夠幫忙解決。

再下先感激各位~神人先進，謝謝。

樓主熱帖

fusayloveme

中學生 Rank: 2

帖子: 46
主題: 12
精華: 0
積分: 72
點名: 0
作業系統: win7
軟體版本: 2007-EXCEL
閱讀權限: 20
性別: 男
註冊時間: 2011-12-29
最後登錄: 2020-3-20

4^#

發表於 2012-6-28 16:32 | 只看該作者

本帖最後由 fusayloveme 於 2012-6-28 16:33 編輯

回復 2# GBKEE
回復 2# c_c_lai

感謝您們的幫助，K大我會找看看有沒有一次性匯入的，台灣網站太少相關類似的整理網站，所以只好找往大陸，美國本國的限於語文障礙....哈

再次感謝您們的幫助，祝您們事事順心，謝謝。

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

3^#

發表於 2012-6-28 05:22 | 只看該作者

回復 1# fusayloveme
回復 2# GBKEE
怎麼會是簡體文呢？我將 G 的作品附上提供大家參考。

中塑資訊網.rar (49.93 KB)

TOP

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^#

發表於 2012-6-27 21:52 | 只看該作者

回復 1# fusayloveme
匯入104 次太久了, 找找看哪裡有可以一次匯入的資料.
以下程式試試看

Option Explicit
Sub Ex()
Dim xi, q As QueryTable, i As Integer, Rng As Range
Sheets("紀錄").Cells.Clear '"紀錄" 工作表
With Sheets("Sheet1") '"Sheet1" 工作表
.Cells.Clear
For Each q In .QueryTables
q.Delete '清除外部查詢
Next
With .QueryTables.Add("URL;http://www.l-zzz.com/shiyou/sy_list.jsp?nID=46", .[a1])
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "17" '取得頁數
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
xi = InStr(.[a1], "/") '字串:"共 1859 條紀錄 1/104" 尋找 "/"位置
xi = Val(Mid(.[a1], xi + 1)) '轉為數字 ' '
For i = xi To 1 Step -1
With .QueryTables(1)
.Connection = "URL;http://www.l-zzz.com/shiyou/sy_list.jsp?nID=46&pageNum=" & i
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "16" '資料位置
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
If i > 1 Then
Set Rng = .QueryTables(1).ResultRange
Set Rng = Rng.Range(Rng.Cells(2, 1), Rng.Cells(Rng.Rows.Count, Rng.Columns.Count))
Rng.Copy '資料複製
Else
.QueryTables(1).ResultRange.Copy
End If
Sheets("紀錄").[a1].Insert Shift:=xlDown '插入資料
Next
End With
End Sub

複製代碼

TOP