標題: [發問] 抓取上市櫃還原股價後，如何調整日期排序及挑出前5年的每年高低點 [打印本頁]

---

作者: tmwcykixe    時間: 2015-4-21 17:10     標題: 抓取上市櫃還原股價後，如何調整日期排序及挑出前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]20759[/attach]
[attach]20760[/attach]

---

作者: tmwcykixe    時間: 2015-4-22 00:22

本帖最後由 tmwcykixe 於 2015-4-22 00:25 編輯

晚上突發起想，以寫函數的方法來試試看，沒想到可行，最高價可以用以下方法挑出.
原倒數第9行以後改成如下,
With ActiveSheet
        .Columns("C:F").NumberFormatLocal = "0.00"
        .Columns("B:B").NumberFormatLocal = "yyyy/m/d"
        .UsedRange.Columns.AutoFit
        .Cells(1, 1).Select
        .Rows("1:2").RowHeight = 30
   
    Range("J3").Select
    ActiveCell.FormulaR1C1 = "2015"
    Range("K3").Select
    ActiveCell.FormulaR1C1 = "2014"
    Range("L3").Select
    ActiveCell.FormulaR1C1 = "2013"
    Range("M3").Select
    ActiveCell.FormulaR1C1 = "2012"
    Range("N3").Select
    ActiveCell.FormulaR1C1 = "2011"
    Range("O3").Select
    ActiveCell.FormulaR1C1 = "2010"
    Range("B2:G1500").Select
    Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
        False
    Range("J4").Select
    Selection.FormulaArray = "=MAX(IF(YEAR(日期)=J3,最高,))"
    Range("K4").Select
    Selection.FormulaArray = "=MAX(IF(YEAR(日期)=K3,最高,))"
    Range("L4").Select
    Selection.FormulaArray = "=MAX(IF(YEAR(日期)=L3,最高,))"
    Range("M4").Select
    Selection.FormulaArray = "=MAX(IF(YEAR(日期)=M3,最高,))"
    Range("N4").Select
    Selection.FormulaArray = "=MAX(IF(YEAR(日期)=N3,最高,))"
    Range("O4").Select
    Selection.FormulaArray = "=MAX(IF(YEAR(日期)=O3,最高,))"
  End With
End Sub

---

作者: joey0415    時間: 2015-4-22 10:47

回復 2# tmwcykixe

寫的真好！又學到好東西

Selection.FormulaArray原來是函數中的{ }
程式中的402應是資料長度，若改為1000也可以抓到1000筆哦！

不過資料量一大，速度就會慢了點

提供一個方向應該會快一些

把資料表當成一個資料庫(excel)中有這個功能，利用sql語法中的group by與 max應該會快很多，就算是十萬筆應該也會比這個快

有機會交流一下

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)