Fund分析统计 VBA源码

最新推荐文章于 2025-04-26 22:22:32 发布

原创最新推荐文章于 2025-04-26 22:22:32 发布 · 900 阅读

2 ·

CC 4.0 BY-SA版权

文章标签：

#vba #integer #string #object #date #function

Perl / VBA 专栏收录该内容

18 篇文章

订阅专栏

本文介绍了一个使用VBA进行财务数据分析的程序，该程序能够计算证券或基金在指定日期范围内的平均值、标准方差等指标，并能展示累计净值与最新净值之间的差异。

Const iROW_OFFSET As Integer = 2 Const iCOL_OFFSET As Integer = 2 Const sAccValueSheet As String = "累计净值_纵" Const sLatValueSheet As String = "最新净值_纵" 'Const sDEST_SHEET As String = "Sheet2" Dim bDateSelectorInited As Boolean 'bDateSelectorInited = False Private Sub cmbRun_Click() Dim iDateOffset1 As Integer, iDateOffset2 As Integer Dim sStartDate As String, sEndDate As String iDateOffset1 = (cbxStartDate.ListIndex + 1) + iROW_OFFSET 'row index of start date iDateOffset2 = (cbxEndDate.ListIndex + 1) + iROW_OFFSET 'row index of end date 'If (iDateOffset1 = iDateOffset2) Then ' MsgBox "Start Date cannot equal to End Date!" ' End 'End If If (iDateOffset1 > iDateOffset2) Then MsgBox "Start Date cannot later than End Date!" End End If 'sStartDate = cbxStartDate.Value 'sEndDate = cbxEndDate.Value Dim iRowIndex As Integer Dim iColIndex As Integer Dim objSourSheet As Object 'Dim objFundNames As Object Dim sTmpStr As String 'HorizontalAlignment = xlCenter Columns("A:F").ClearContents sTmpStr = "(" & cbxStartDate.Value & " ～ " & cbxEndDate.Value & ")" With Cells(1, 1) .Value = "证券名称/基金名称" & vbCrLf & sTmpStr .Font.Name = "Arial" .Font.Size = 12 .Font.Bold = True End With Columns("B:E").HorizontalAlignment = xlRight Cells(1, 2).Value = "区间平均值" Cells(1, 3).Value = "区标准方差" Cells(1, 4).Value = "标准差系数" Cells(1, 5).Value = "区间增长率" Set objSourSheet = Worksheets(sAccValueSheet) iColIndex = iCOL_OFFSET 'column index in sAccValueSheet to calculate value iRowIndex = iROW_OFFSET 'row index to assign formula sTmpStr = objSourSheet.Cells(1, iColIndex).Value Do While (sTmpStr <> "") 'loop when fund's name is not empty string Dim iTmpIdx As Integer iTmpIdx = 0 On Error Resume Next iTmpIdx = Application.WorksheetFunction.Find("成交量", sTmpStr) If (Not IsEmpty(iTmpIdx) And iTmpIdx > 0) Then iColIndex = iColIndex + 1 sTmpStr = objSourSheet.Cells(1, iColIndex).Value GoTo Next1 End If Next2: Dim sFormula As String With Cells(iRowIndex, 1) .Value = sTmpStr .Font.Name = "Arial" .Font.Size = 11 .Font.Bold = True End With sFormula = "=AVERAGE(" & sAccValueSheet & "!R" & iDateOffset1 & "C" & iColIndex & ":R" & iDateOffset2 & "C" & iColIndex & ")" With Cells(iRowIndex, 2) .FormulaR1C1 = sFormula .NumberFormatLocal = "0.0000_ " End With sFormula = "=VARP(" & sAccValueSheet & "!R" & iDateOffset1 & "C" & iColIndex & ":R" & iDateOffset2 & "C" & iColIndex & ")" With Cells(iRowIndex, 3) .FormulaR1C1 = sFormula .NumberFormatLocal = "0.0000_ " End With sFormula = ("=SQRT(R" & iRowIndex & "C3)/R" & iRowIndex & "C2") 'sqrt(col3)/col2 for this row With Cells(iRowIndex, 4) .FormulaR1C1 = sFormula .NumberFormatLocal = "0.000%" End With sFormula = "=(" & sAccValueSheet & "!R" & iDateOffset1 & "C" & iColIndex & " - " _ & sAccValueSheet & "!R" & (iDateOffset2 + 1) & "C" & iColIndex & ")/" _ & sLatValueSheet & "!R" & (iDateOffset2 + 1) & "C" & iColIndex With Cells(iRowIndex, 5) .FormulaR1C1 = sFormula .NumberFormatLocal = "0.000%" End With '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim objTestSheet As Object Dim objAccValueSheet As Object Dim objLatValueSheet As Object Set objTestSheet = Worksheets("Test") Set objAccValueSheet = Worksheets(sAccValueSheet) Set objLatValueSheet = Worksheets(sLatValueSheet) Cells(1, 6).Value = "累计/最新净值的差值" For i = 0 To (iDateOffset2 - iDateOffset1) With objTestSheet.Cells(i + 1, 1) .Value = (objAccValueSheet.Cells(iDateOffset1 + i, iColIndex).Value - objLatValueSheet.Cells(iDateOffset1 + i, iColIndex).Value) .NumberFormatLocal = "0.000_ " End With Next i 'sFormula = "=VARP(" & sAccValueSheet & "!R" & iDateOffset1 & "C" & iColIndex & ":R" & iDateOffset2 & "C" & iColIndex & ")" With Cells(iRowIndex, 6) .Value = Application.WorksheetFunction.VarP(objTestSheet.Range("A1:A" & (iDateOffset2 - iDateOffset1 + 1))) .NumberFormatLocal = "0.00%" End With '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Do iColIndex = iColIndex + 1 sTmpStr = objSourSheet.Cells(1, iColIndex).Value Dim bMerged As Boolean bMerged = (Range("A" & iColIndex).CurrentRegion.Address = Range("A" & iColIndex - 1).CurrentRegion.Address) Loop While (sTmpStr = "" And bMerged) iRowIndex = iRowIndex + 1 Next1: Loop End Sub Private Sub lbStartDate_Click() End Sub Private Sub Worksheet_Activate() Application.DisplayAlerts = False If Not bDateSelectorInited Then initDateSelector bDateSelectorInited = True End If End Sub Private Sub initDateSelector() Dim sDateStr As String Dim iIndex As Integer Dim objSourSheet As Object cbxStartDate.Clear cbxEndDate.Clear cbxStartDate.Value = "" cbxEndDate.Value = "" Set objSourSheet = Worksheets(sAccValueSheet) iIndex = iROW_OFFSET + 1 sDateStr = objSourSheet.Range("A" & iIndex).Value Do While (sDateStr <> "") If (isDate(sDateStr)) Then cbxStartDate.AddItem (sDateStr) cbxEndDate.AddItem (sDateStr) End If iIndex = iIndex + 1 sDateStr = objSourSheet.Range("A" & iIndex).Value Loop cbxStartDate.ListIndex = 0 cbxEndDate.ListIndex = 0 End Sub Private Function isDate(ByVal dateStr As String) As Boolean Dim result As Boolean result = False On Error GoTo EH result = True EH: isDate = result End Function