Sub 股东与股价相对曲线() Dim obj As AcadObject For Each obj In ThisDrawing.ModelSpace obj.Delete Next ThisDrawing.Application.Update Dim a() As Double, p() As Double f = "002106" On Error Resume Next Set oDoc = CreateObject("htmlfile") Set ww = CreateObject("WinHttp.WinHttpRequest.5.1") With CreateObject("Microsoft.XMLHTTP") .Open "GET", "http://stock.finance.qq.com/corp1/stk_holder_count.php?zqdm=" & f, False .send oDoc.body.innerHTML = .responsetext Set r = oDoc.all.tags("table")(1).Rows ReDim a(0 To 3 * r.Length - 7), p(0 To 3 * r.Length - 7) c = 10000000.00011 d = 0.0000035 s = 10000 t = 0.0000000035 For i = 1 To r.Length - 2 a((i - 1) * 3) = r.Length - i p((i - 1) * 3) = r.Length - i a((i - 1) * 3 + 1) = r(i).Cells(2).innerText / r(i).Cells(3).innerText If c > a((i - 1) * 3 + 1) Then c = a((i - 1) * 3 + 1) g = r.Length - i End If If d < a((i - 1) * 3 + 1) Then d = a((i - 1) * 3 + 1) a((i - 1) * 3 + 2) = 0 p((i - 1) * 3 + 2) = 0 h = r(i).Cells(0).innerText 1: ww.Open "GET", "http://q.stock.sohu.com/hisHq?code=cn_" & f & "&start=" & Format(h, "yyyymmdd") & "&end=" & Format(h, "yyyymmdd") & "&stat=1&order=D&period=d&callback=a&rt=jsonp", False ww.send p((i - 1) * 3 + 1) = Split(ww.responsetext, """,""")(2) If p((i - 1) * 3 + 1) < 0.01 Then h = DateAdd("d", -1, h) GoTo 1 End If If i < 20 And s > p((i - 1) * 3 + 1) Then s = p((i - 1) * 3 + 1) t = r.Length - i End If 'Debug.Print h, p((i - 1) * 3 + 1) Next i For i = 1 To r.Length - 1 a((i - 1) * 3 + 1) = a((i - 1) * 3 + 1) / c p((i - 1) * 3 + 1) = p((i - 1) * 3 + 1) / s Next i End With Dim splineobj As AcadSpline Dim starttan(0 To 2) As Double Dim endtan(0 To 2) As Double Dim point1(0 To 2) As Double Dim point2(0 To 2) As Double Dim fitpoints(0 To 8) As Double starttan(0) = 0: starttan(1) = 0: starttan(2) = 0 endtan(0) = 0: endtan(1) = 0: endtan(2) = 0 point1(0) = g: point1(1) = 1: point1(2) = 0 point2(0) = r.Length: point2(1) = d / s: point2(2) = 0 Set splineobj = ThisDrawing.ModelSpace.AddSpline(a, starttan, endtan) splineobj.color = acRed Set Annotation = ThisDrawing.ModelSpace.AddMText(point1, 20, Format(c, "0.000")) Annotation.Height = 1 point1(0) = t: point1(1) = 2: point1(2) = 0 Set splineobj = ThisDrawing.ModelSpace.AddSpline(p, starttan, endtan) Set Annotation = ThisDrawing.ModelSpace.AddMText(point1, 20, s) Annotation.Height = 1 ThisDrawing.Application.ZoomWindow starttan, point2 ThisDrawing.Application.Update End Sub
时间: 2024-10-11 00:22:13