- 帖子
- 4
- 主題
- 1
- 精華
- 0
- 積分
- 5
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- 2010
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2014-6-5
- 最後登錄
- 2022-3-11
|
[發問] 抓取上市櫃還原股價後，如何調整日期排序及挑出前5年的每年高低點
本篇係參考http://ric1565.blogspot.tw/2015/02/blog-post_24.html .
請教各位先進，經抓取股價資料後，日期應如何將最近的日期由上往下排序，並如何挑出前5年的每年股價最高及最低點。
程式碼如下：
Sub ComBoxInit()
With ComboBox2
.List = Array("日線", "還原日線")
.Text = "清單"
End With
End Sub
Private Sub ComboBox2_Change()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub CommandButton1_Click()
Dim web
Dim URL As String, code As String
Dim i As Long, j As Integer, d As Integer
If TextBox1.Text = "" Then Exit Sub
code = TextBox1.Text
URL = "http://jsstock.wls.com.tw/Z/ZC/ZCW/CZKC1.djbcd?c=402&b=" & IIf(ComboBox2.Text = "還原日線", "A", _
IIf(ComboBox2.Text = "名目週線", "W", "M")) & "&a=" & code
Set web = CreateObject("Microsoft.XMLHTTP")
web.Open "get", URL, False
web.send
ReDim arr(1 To Int((Len(web.responseText) - Len(Replace(web.responseText, ",", ""))) / _
(Len(web.responseText) - Len(Replace(web.responseText, " ", "")) + 1)) + 1, 1 To 6)
For i = 1 To 6
For j = 1 To Int((Len(web.responseText) - Len(Replace(web.responseText, ",", ""))) / _
(Len(web.responseText) - Len(Replace(web.responseText, " ", "")) + 1)) + 1
arr(j, i) = Application.Index(Split(Application.Index(Split(web.responseText, " "), 1, i), ","), 1, j)
Next j
Next i
Do Until Application.WorksheetFunction.CountA(ActiveSheet.UsedRange) = 0
ActiveSheet.Cells.Delete
ActiveSheet.Cells.Clear
Loop
Range(Cells(2 + 1, 1 + 1), Cells(2 + j - 1, 1 + i - 1)) = arr
Cells(2, 2) = "日期"
Cells(2, 3) = "開盤"
Cells(2, 4) = "最高"
Cells(2, 5) = "最低"
Cells(2, 6) = "收盤"
Cells(2, 7) = "成交量"
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("B3:" & Application.WorksheetFunction.Index(Split(ActiveSheet.UsedRange.Address, ":"), 1, 2))
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
If Cells(65536, 2).End(xlUp).Row > 2 Then
For d = 1 To Year(Cells(3, 2)) - Year(Cells(65536, 2).End(xlUp))
Cells(2 + d, 9) = Year(Cells(3, 2)) - (d - 1)
Cells(2, 12) = 3
Cells(2 + d, 12).Formula = "=Match(" & (DateSerial(Year(Date) - d, 12, 31) + 0.1) * 1 & ",B:B,-1)"
Cells(2 + d, 10) = Application.WorksheetFunction.Max(Range(Cells(Cells(1 + d, 12), 4), Cells(Cells(2 + d, 12), 4)))
Cells(2 + d, 11) = Application.WorksheetFunction.Min(Range(Cells(Cells(1 + d, 12), 5), Cells(Cells(2 + d, 12), 5)))
Next d
End If
Cells(3, 9) = "年度"
Cells(4, 9) = "最高"
Cells(5, 9) = "最低"
Columns(12).Delete
With ActiveSheet
.Columns("C:F").NumberFormatLocal = "0.00"
.Columns("J:K").NumberFormatLocal = "0.00"
.Columns("B:B").NumberFormatLocal = "yyyy/mm/dd"
.UsedRange.Columns.AutoFit
.Cells(1, 1).Select
.Rows("1:2").RowHeight = 30
End Sub
[attach]20760[/attach] |
-
-
活頁簿2.rar
(55.84 KB)
|
發表於 2015-4-21 17:10
| 
