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

追梦人亮

大神，怎样把每个季度最后一天的股票数据提出来？
如第一个季度末是3月31日，则把这一天收盘价提取出来，如果这天正好周六，则提取出前一天。谢谢了！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-3-20 22:09

追梦人亮 发表于 2014-3-21 13:09
非常感谢老师这么热心的回答，是只有那一天的写入，如表中样式。非常感谢！

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.             Set rg = Columns(1).Find(what:=dt1, lookat:=xlWhole)
    
18.             If Not rg Is Nothing Then
    
19.                 k = k + 1
    
20.                 result(k, 1) = dt2
    
21.                 result(k, 2) = rg.Offset(, 1).Value
    
22.                 result(k, 3) = dt1
    
23.              End If
    
24.         Next
    
25.     Next
    
26.     Range("c1").Resize(k, UBound(result, 2)).Value = result
    
27.     MsgBox "ok"
    
28. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

追梦人亮 发表于 2014-3-21 13:09
非常感谢老师这么热心的回答，是只有那一天的写入，如表中样式。非常感谢！

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.             Set rg = Columns(1).Find(what:=dt1, lookat:=xlWhole)
    
18.             If Not rg Is Nothing Then
    
19.                 k = k + 1
    
20.                 result(k, 1) = dt2
    
21.                 result(k, 2) = rg.Offset(, 1).Value
    
22.                 result(k, 3) = dt1
    
23.              End If
    
24.         Next
    
25.     Next
    
26.     Range("c1").Resize(k, UBound(result, 2)).Value = result
    
27.     MsgBox "ok"
    
28. End Sub

复制代码

hwc2ycy

1. Sub test()
   
2.     Dim strTemp
   
3.     Dim dt1 As Date, i As Byte
   
4.     Dim rg As Range
   
5.     strTemp = Application.InputBox("请软件要查询的季度日期", , "1991-3-31", Type:=2)
   
6.     If Not IsDate(strTemp) Then
   
7.         MsgBox "输入的非日期格式"
   
8.         Exit Sub
   
9.     End If
   
10.     dt1 = CDate(strTemp)
    
11.     i = Weekday(dt1, vbMonday)
    
12.     If i > 5 Then
    
13.         dt1 = Date - i + 5
    
14.     End If
    
15. 
    
16.     Set rg = Columns(1).Find(what:=dt1, lookat:=xlWhole)
    
17.     If rg Is Nothing Then
    
18.         MsgBox "A列无指定日期的数据"
    
19.         Exit Sub
    
20.     End If
    
21.     MsgBox Format(rg.Offset(, 1).Value, "0.00")
    
22. End Sub

复制代码

追梦人亮

hwc2ycy 发表于 2014-3-20 23:38

谢谢老师，能不能直接把每季度最后一日的数据放到第三列，如果要一个个查太麻烦了，非常感谢您的回答！

hwc2ycy

追梦人亮 发表于 2014-3-21 08:27
谢谢老师，能不能直接把每季度最后一日的数据放到第三列，如果要一个个查太麻烦了，非常感谢您的回答！

是第三列每一个单元格都需要所在季度的价么？还是只有那一天的才写入价格。

hwc2ycy

1. Sub test()
   
2.     Dim dt1 As Date, dt2 As Date, i%
   
3.     Dim arr, j As Byte
   
4.     arr = Range("a1:c" & Cells(Rows.Count, 1).End(xlUp).Row).Value
   
5.     For i = 1 To UBound(arr)
   
6.         dt1 = arr(i, 1)
   
7.         If IsDate(dt1) Then
   
8.             If Month(dt1) Mod 3 = 0 Then
   
9.                 dt2 = DateAdd("m", 1, dt1)
   
10.                 dt2 = dt2 - Day(dt2)
    
11.                 j = Weekday(dt2, vbMonday)
    
12.                 If j > 5 Then
    
13.                     dt2 = dt2 - j + 5
    
14.                 End If
    
15.                 If dt2 = dt1 Then
    
16.                     arr(i, 3) = arr(i, 2)
    
17.                 End If
    
18.             End If
    
19.         End If
    
20.     Next
    
21.     Range("a1").Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
22.     MsgBox "ok"
    
23. End Sub

复制代码

只把每一季度最后一天符合要求的价格写入了对应行的第三列。

tgydslr

股票数据 亮.rar (96.99 KB, 下载次数: 21)

2014-3-21 10:56 上传

点击文件名下载附件

追梦人亮

hwc2ycy 发表于 2014-3-21 08:58
是第三列每一个单元格都需要所在季度的价么？还是只有那一天的才写入价格。

非常感谢老师这么热心的回答，是只有那一天的写入，如表中样式。非常感谢！

追梦人亮

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

版主太帅了，非常感谢

追梦人亮

tgydslr 发表于 2014-3-21 10:56

不好意思啊，你帮我做的才是是最符合要求的！