[已解决]求大神帮助，怎样提取每个季度最后一天的股票价格？

追梦人亮

hwc2ycy 发表于 2014-3-20 22:09

老师，您好，还有点小问题，就是有的年份会出现只有3个季度的情况，少了第四季度，因为最后一个季度很早就闭市了，如12月25日就是某一年的最后一个收盘价了，但好像这个收盘价没有出来。谢谢啦

hwc2ycy

追梦人亮 发表于 2014-3-23 14:54
老师，您好，还有点小问题，就是有的年份会出现只有3个季度的情况，少了第四季度，因为最后一个季度很早就 ...

==，我等会看看。

追梦人亮

hwc2ycy 发表于 2014-3-23 15:16
==，我等会看看。

老师，打扰一下，我提的那个问题有进展吗？

hwc2ycy

追梦人亮 发表于 2014-3-25 21:57
老师，打扰一下，我提的那个问题有进展吗？

不好意思，白天还想着你那个题，结果后来忘了，

hwc2ycy

1. Sub test()
   
2.     Dim dt1 As Date, dt2 As Date
   
3.     Dim i%, j%, k%, l As Byte
   
4.     Dim result(1 To 1000, 1 To 3)
   
5.     result(1, 1) = "季度"
   
6.     result(1, 2) = "价格"
   
7.     result(1, 3) = "实际日期"
   
8.     k = 1
   
9.     For i = 1991 To 2013
   
10.         For j = 3 To 12 Step 3
    
11.             dt1 = DateAdd("m", 1, DateValue(i & "-" & j & "-" & 1)) - 1
    
12.             dt2 = dt1
    
13.             l = Weekday(dt1, vbMonday)
    
14.             If l > 5 Then
    
15.                 dt1 = dt1 - l + 5
    
16.             End If
    
17.             Do
    
18.                 Set rg = Columns(1).Find(what:=dt1, lookat:=xlWhole)
    
19.                 If rg Is Nothing Then
    
20.                     dt1 = dt1 - 1
    
21.                 End If
    
22.             Loop While rg Is Nothing And Month(dt1) = Month(dt2)
    
23. 
    
24.             If Not rg Is Nothing Then
    
25.                 k = k + 1
    
26.                 result(k, 1) = dt2
    
27.                 result(k, 2) = rg.Offset(, 1).Value
    
28.                 result(k, 3) = dt1
    
29.             End If
    
30.         Next
    
31.     Next
    
32.     Range("c1:e" & Cells(Rows.Count, "c").End(xlUp).Row).ClearContents
    
33.     Range("c1").Resize(k, UBound(result, 2)).Value = result
    
34.     MsgBox "ok"
    
35. End Sub
    

复制代码