- 帖子
- 112
- 主題
- 19
- 精華
- 0
- 積分
- 136
- 點名
- 0
- 作業系統
- window
- 軟體版本
- excel
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2013-3-12
- 最後登錄
- 2022-11-29
|
sheet1 存放一年的股權變換資料
sheet2 存放一年的股權有效日期
sheet3 抓下每月股權的股權變換資料並存放到sheet1
sheet4 股票代號，屆時這裡是可以變數方式來抓取想觀察的股權變換資料
於是將G大的格式修改如下：- Sub 集保戶股權分散表查詢_WEB()
- Dim Ar(), A, i As Integer, strDate As String, stkno As String, Qur As String
- With CreateObject("InternetExplorer.Application")
- .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
- Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
- Set A = .document.All.tags("option") '資料日期的內容
- ReDim Ar(A.Length - 1)
- For i = 0 To A.Length - 1
- Ar(i) = A(i).innerHTML
- If InStr(Ar(i), Format(Date, "YYYYMM")) Then strDate = Ar(i) '導入當月日期
- Next
- .Quit
- End With
-
- For DQ = 1 To 3
- Sheets(DQ).Select
- Cells.Clear
- Next DQ
-
- For i = 1 To 12
- Sheets(2).Select
- Range("a" & i + 1).Value = Ar(i)
- Next i
-
- Range("a" & 14).Value = Ar
-
- With Worksheets(2) 'sorting
- Range("A1:ac20").Sort _
- Key1:=.Range("a1"), _
- Order1:=xlDescending, _
- Header:=xlYes, _
- Orientation:=xlTopToBottom
- End With
- 'End Sub
-
- TotalDate2 = 1
-
- For Totaldate = 2 To 14
- 'Do
- ' strDate = InputBox(Join(Ar, vbTab), "集保戶股權分散表查詢 之 有效日期", strDate)
- strDate = Sheets(2).Range("a" & Totaldate)
- ' If strDate = "" Then Exit Sub
-
- 'Loop Until IsNumeric(Application.Match(strDate, Ar, 0))
-
- stkno = Sheets(4).Range("a1") '
-
- If stkno = "" Then Exit Sub
- Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
- If Sheets(3).QueryTables.Count = 0 Then
- Sheets(3).QueryTables.Add "URL;" & Qur, Sheets(3).[A1]
- Else
- Sheets(3).QueryTables(1).Connection = "URL;" & Qur
- End If
- With Sheets(3).QueryTables(1)
- .Name = "持股分佈"
- .FieldNames = True
- .RowNumbers = False
- .FillAdjacentFormulas = False
- .PreserveFormatting = False
- .RefreshOnFileOpen = False
- .BackgroundQuery = True
- .RefreshStyle = xlOverwriteCells
- .SavePassword = False
- .SaveData = True
- .AdjustColumnWidth = False
- .RefreshPeriod = 0
- .WebSelectionType = xlSpecifiedTables
- .WebFormatting = xlWebFormattingNone
- .WebTables = "6,7,8"
- .WebPreFormattedTextToColumns = True
- .WebConsecutiveDelimitersAsOne = True
- .WebSingleBlockTextImport = False
- .WebDisableDateRecognition = False
- .WebDisableRedirections = False
- .Refresh BackgroundQuery:=False
- End With
-
- Worksheets(3).Select '收集資料到sheet1
- Range("a3:e21").Select
- Application.CutCopyMode = False
- Selection.Copy
-
-
- Worksheets(1).Select
- Range("a" & TotalDate2).Select
- ActiveSheet.Paste
- TotalDate2 = TotalDate2 + 20
-
- Next Totaldate
- End Sub
|
|
發表於 2013-12-3 15:38
| 
