如何将股票历史日数据转换为周数据

leobu · 发表于 2019-10-31 09:03

各位高手：

有问题请教。现在需要将若干只股票历史交易的日数据转换为周数据，基本原则是：将周初的开盘价作为本周的开盘价，周末的收盘价作为本周的收盘价，本周所有交易日的最高价作为本周的最高价，本周所有交易日的最低价作为本周的最低价，本周所有交易日的成交量之和作为本周的成交量，本周所有交易日的成交金额之和作为本周的成交金额。

例如，所给出的原始数据如图1所示，2018年3月12日（周一）至3月16日（周五）算作一周。此时对于周末3月16日的数据修改如下：

D6（收盘价）保持不变；

E6（最高价）修改成max（E2:E6）；

F6（最低价）修改成min（F2:F6）；

G6（开盘价）修改成G2；

H6（成交量）修改成sum(H2:H6)；

I6（成交金额）修改成sum(I2:I6)，

然后删除3月12日至3月15日的数据。

这里的问题是：

有些周的天数不固定，例如第二周仅有3月20日（周二）至3月22日（周四）这3天的数据，此时就把3月20日作为周初，3月22日作为周末进行以上运算。对于最后一周，仅有4月3日这1天的数据，就不做改动。

最后修改完成的数据如图2所示。

现在有数百张数据需要做这样的修改，请问如何用VBA实现？

非常感谢！

爱疯 · 发表于 2019-10-31 11:04

Sub test()
Dim i
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
      Sheets(i).Select
      Call fzl
      Call flhz
      Call zl
Next i
End Sub

'辅助列
Private Sub fzl()
Cells(1, "j") = "周数"
Range("j2:j" & Range("a65536").End(xlUp).Row) = "=WEEKNUM(A2)"
End Sub

'分类汇总
Private Sub flhz()
With Range("a1").CurrentRegion
      .RemoveSubtotal
      .Sort key1:=[a1], order1:=xlAscending, Header:=xlYes
      .Subtotal GroupBy:=10, Function:=xlSum, TotalList:=Array(8, 9)
End With
End Sub

'整理
Private Sub zl()
Dim A, i, j, x, y, z
i = Range("i65536").End(xlUp).Row
Rows(i).EntireRow.Delete
Range("j:j") = ""
i = i - 1
Range("a2:c" & i).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"

A = Range("d2:g" & i)
For i = 1 To UBound(A)
      If A(i, 1) = "" Then
         A(i, 1) = A(i - 1, 1) '收盘
         A(i, 2) = x          '最高
         A(i, 3) = y          '最低
         A(i, 4) = z          '开盘
         x = 0: y = 0: z = 0
      Else
         If x = 0 Then x = A(i, 2) Else If x < A(i, 2) Then x = A(i, 2)
         If y = 0 Then y = A(i, 3) Else If y > A(i, 3) Then y = A(i, 3)
         If z = 0 Then z = A(i, 4)
      End If
Next i
[d2].Resize(UBound(A), UBound(A, 2)) = A
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("a1").CurrentRegion.EntireColumn.AutoFit
End Sub

如何将股票历史日数据转换为周数据3.rar (22.9 KB, 下载次数: 13)

leobu · 发表于 2019-10-31 12:22

爱疯发表于 2019-10-31 11:04
Sub test()
Dim i
Application.ScreenUpdating = False

感谢爱疯老师的帮助，好几次都来麻烦您了，您真是大神啊！

这里还有个问题：现在出来的计算结果采用的是隐藏形式，如图1所示。

现在如果想把隐藏的数据都删掉，只保留已经替换好的周末数据，例如，对于000001这只股票，只想保留2018年3月16日、3月22日、3月30日、4月3日这几天的替换好的数据，把其他的数据都删掉。该怎样修改程序？

再次感谢您的帮助！

爱疯 · 发表于 2019-10-31 15:32

'入口
Sub test()
Dim i
If [m1] <> "" Then End '只执行1次
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
      Sheets(i).Select
      Call fzl
      Call flhz
      Call zl
Next i
Sheets(1).[m1] = Format(Now, "统计时间: yyyy/mm/dd hh:mm:ss") '指定M1存放标记
End Sub

'辅助列
Private Sub fzl()
Cells(1, "j") = "周数"
Range("j2:j" & Range("a65536").End(xlUp).Row) = "=WEEKNUM(A2)"
End Sub

'分类汇总
Private Sub flhz()
With Range("a1").CurrentRegion
      .RemoveSubtotal
      .Sort key1:=[a1], order1:=xlAscending, Header:=xlYes
      .Subtotal GroupBy:=10, Function:=xlSum, TotalList:=Array(8, 9)
End With
End Sub

'整理
Private Sub zl()
Dim A, i, x, y, z
i = Range("i65536").End(xlUp).Row
Rows(i).EntireRow.Delete
Range("j:j") = ""
i = i - 1
Range("a2:c" & i).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"

A = Range("d2:g" & i)
For i = 1 To UBound(A)
      If A(i, 1) = "" Then
         A(i, 1) = A(i - 1, 1) '收盘
         A(i, 2) = x          '最高
         A(i, 3) = y          '最低
         A(i, 4) = z          '开盘
         x = 0: y = 0: z = 0
      Else
         If x = 0 Then x = A(i, 2) Else If x < A(i, 2) Then x = A(i, 2)
         If y = 0 Then y = A(i, 3) Else If y > A(i, 3) Then y = A(i, 3)
         If z = 0 Then z = A(i, 4)
      End If
Next i
[d2].Resize(UBound(A), UBound(A, 2)) = A

ActiveSheet.Outline.ShowLevels RowLevels:=2
Range([a2], Cells(i, "i")).SpecialCells(xlCellTypeVisible).Copy Cells(i + 1, 1)
Rows("2:" & i).Delete
Columns("a:i").AutoFit
ActiveWindow.ScrollRow = 1
End Sub

如何将股票历史日数据转换为周数据4.rar (22.83 KB, 下载次数: 22)

leobu · 发表于 2019-10-31 16:13

爱疯发表于 2019-10-31 15:32
'入口
Sub test()
Dim i

大神就是大神！再次感谢您！

爱疯 · 发表于 2019-10-31 16:15

没什么，应该很多朋友也能做，只不过那时他们没空

		自动登录	找回密码
密码			注册