返回列表 上一主題 發帖

請問如何截取指定參數網路內容之指定欄位資料?

請問如何截取指定參數網路內容之指定欄位資料?

本帖最後由 peter460191 於 2012-1-4 13:44 編輯

對照不同參數截取指定欄位資料.rar (3.63 KB)
圖片2.jpg
2012-1-4 13:39

請問如何按 A欄的參數,截取網佔內容之J 欄及O欄所對應年度股利之資料
查詢網址→http://justdata.yuanta.com.tw/z/zc/zcc/zcc_1101.asp.htm→代號參數可變
peter460191

回復 1# peter460191
  1. Sub Ex()
  2.     Dim E As Range, Ar()
  3.     With Sheets("Sheet1")
  4.         For Each E In .Range(.[A6], .[A6].End(xlDown))   '股票代號區域
  5.             With Sheets("Sheet2").[A1].QueryTable        'Sheet2").[A1] 請設有外部查詢
  6.                 .Connection = "URL;http://justdata.yuanta.com.tw/z/zc/zcc/zcc_" & E & ".asp.htm"
  7.                 .WebSelectionType = xlSpecifiedTables
  8.                 .WebFormatting = xlWebFormattingNone
  9.                 .WebTables = "4"
  10.                 .WebPreFormattedTextToColumns = True
  11.                 .WebConsecutiveDelimitersAsOne = True
  12.                 .WebSingleBlockTextImport = False
  13.                 .WebDisableDateRecognition = False
  14.                 .WebDisableRedirections = False
  15.                 .Refresh BackgroundQuery:=False
  16.                 With .ResultRange
  17.                     Ar = .Range(.Cells(2, 6), .Cells(6, 6)).Value   '年度股利合計範圍
  18.                 End With
  19.             End With
  20.             E.Offset(, 2).Resize(1, 5) = Application.Transpose(Ar)  '年度股利合計 複製於 股票代號區域向右2欄(1列,5欄)
  21.         Next
  22.     End With
  23. End Sub
複製代碼

TOP

回復 2# GBKEE

感謝 GBKEE 版大

試過後已可自動抓取資料,謝謝您!
另外,若要在『代號』參數改變後,自動變更資料,還要加那些程式,請幫忙!
再一次謝謝您!
peter460191

TOP

回復 3# peter460191
須複製到 Sheet1
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Application.EnableEvents = False          'False  指定物件不能觸發事件
  4.     'EnableEvents 屬性 如果指定物件能觸發事件,則本屬性為 True
  5.     If Not Intersect(Target(1), Range([A6], [A6].End(xlDown))) Is Nothing Then Ex Target(1)
  6.       'Intersect 方法 傳回 Range 物件,此物件代表兩個或多個範圍重疊的矩形範圍。
  7.     Application.EnableEvents = True           'True  指定物件能觸發事件
  8. End Sub
  9. Private Sub Ex(E As Range)  '接受參數 E As Range
  10.     Dim Ar()
  11.     With Sheets("Sheet2").[A1].QueryTable        ' ***Sheet2").[A1] 請設有外部查詢***
  12.         .Connection = "URL;http://justdata.yuanta.com.tw/z/zc/zcc/zcc_" & E & ".asp.htm"
  13.         .WebSelectionType = xlSpecifiedTables
  14.         .WebFormatting = xlWebFormattingNone
  15.         .WebTables = "4"
  16.         .WebPreFormattedTextToColumns = True
  17.         .WebConsecutiveDelimitersAsOne = True
  18.         .WebSingleBlockTextImport = False
  19.         .WebDisableDateRecognition = False
  20.         .WebDisableRedirections = False
  21.         .Refresh BackgroundQuery:=False
  22.         With .ResultRange
  23.             Ar = .Range(.Cells(2, 6), .Cells(6, 6)).Value   '年度股利合計範圍
  24.         End With
  25.     End With
  26.     E.Offset(, 2).Resize(1, 5) = Application.Transpose(Ar)  '年度股利合計 複製於 股票代號區域向右2欄(1列,5欄)
  27.     '這裡 Sheets("Sheet1")有輸入: 會觸動Sheets("Sheet1")的  Private Sub Worksheet_Change
  28.     'Application.EnableEvents = False ->  不會觸發Sheets("Sheet1")的  Private Sub Worksheet_Change
  29. End Sub
複製代碼

TOP

各位樓主大大您好:

   小弟這幾日一直鑽研此篇幅
仍然無法領會,還請各位大大指點
迷津。
一、第二篇版主提到要在sheet2裡
'Sheet2").[A1] 請設有外部查詢
應如何增設呢?
小弟已增列:d:\temp\zcc_1101.iqy
WEB
1
http://justdata.yuanta.com.tw/z/zc/zcc/zcc_1101.asp.htm

Selection=4
Formatting=None
PreFormattedTextToColumns=True
ConsecutiveDelimitersAsOne=True
SingleBlockTextImport=False
DisableDateRecognition=False
DisableRedirections=False

二、請問此網頁為何並未有首頁
可登入呢?

感恩各位大大?

TOP

回復 5# dechiuan999
Sheets("Sheet2").[A1] 請設有外部查詢  應如何增設呢?  小弟已增列:d:\temp\zcc_1101.iqy
到Sheet2 選擇A1  
指令 資料->匯入外部資料->匯入資料  :  [選取資料來源] 開啟   d:\temp\zcc_1101.iqy

TOP

謝謝版主大大。
指令 資料->匯入外部資料->匯入資料  :  [選取資料來源] 開啟   d:\temp\zcc_1101.iqy
第二篇語法已測成功。

另第四篇的語法,分為二段
第一段小弟將其擺放在sheets1裡的工作表事件,
而第二段小弟放置在模組內,但無法執行此模組。並在a7輸入股票代號
之後卻無反應,如果全部將其擺放至sheet1工作表事件內
也是不行。請問其原因為何呢?

感恩大大!

TOP

回復 7# dechiuan999
而第二段小弟放置在模組內,但無法執行此模組

Private Sub Ex(E As Range)  '接受參數 E As Range   刪掉 Private

TOP

謝謝版主大大。
小弟已遵照版主指示
也是沒有動作
可能是在家裡使用
excel 2002版的關係吧!
我明天到公司改用
excel2010版試試

感恩版主大大!

TOP

回復 4# GBKEE


    謝謝GBKEE版大幫忙!
   已可以執行隨代號變動資料,一定要花幾天好好研究內容, 自己試著把股名也顯示出來, 再一次謝謝版大!
peter460191

TOP

        靜思自在 : 【停滯不前,終無所得】人都迷於尋找奇蹟,因而停滯不前;縱使時間再多、路再長,也了無用處,終無所得。
返回列表 上一主題