在输入框中输入日期,然后在VBA上找到上个月的日期

时间:2019-06-25 13:42:44

标签: excel vba

我目前正在使用VBA代码,在该代码中,您可以在输入框中以以下格式输入日期:YYYY-MM。

然后,我使用一个函数来查找其值与输入框的值匹配的单元格,并在具有所述日期的单元格下面的行中复制信息。 每7列用于一个日期的数据(第一列是风险值,第二列是风险值的变化,第三列是市场价值,第四列是市场价值的变化,依此类推),每一行代表不同的投资组合。每个投资组合的数据都从其他工作簿复制而来。

接下来的7列是上个月的数据。

我现在要计算一个月到另一个月的风险价值变化。

为此,我需要找到在输入框中输入日期之前的月份的日期,并从该列中复制有风险的值,将其分配给变量,最后归因于公式:(当前风险值-先前风险值)/(先前风险值)。市值的变化也是如此。

我不知道该怎么做,因为我是VBA的新手。任何帮助将非常感激。这是我到目前为止的内容:

Option Explicit

Function MatchHeader(strSearch As String) As Long
    Dim myRight As Long, Colcount As Long
    myRight = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column

    For Colcount = 1 To myRight
        If ActiveSheet.Cells(1, Colcount) = strSearch Then
            MatchHeader = Colcount
            Exit For
        End If
    Next Colcount
End Function


Sub StressTest()
    Dim index As Integer
    Dim dateColumn As Integer
    Dim portfolioName As Variant
    Dim portfolioDate As String
    Dim ParametricVar As Double
    Dim AuM As Double
    Dim strPath As String
    Dim strFilePath As String
    Dim wb As Workbook
    Dim sheet As Worksheet

    Set wb = ThisWorkbook
    Set sheet = ActiveSheet

    portfolioDate = InputBox("Please enter date under the following form : YYYY-MM", "Date at the time of Stress Test", "Type Here")
    Debug.Print "InputBox provided value is: " & portfolioDate

    For index = 3 To Cells(Rows.Count, "A").End(xlUp).Row
        dateColumn = MatchHeader(portfolioDate)
        portfolioName = ActiveSheet.Range("A" & index & "").Value

        strPath = "G:\Risk\Risk Reports\VaR-Stress test\" & portfolioDate & "\" & portfolioName & ""

        Set wb = Workbooks.Open(strPath)

        ParametricVar = Workbooks(portfolioName).Worksheets("VaR Comparison").Range("B19")
        AuM = Workbooks(portfolioName).Worksheets("Holdings - Main View").Range("E11")

        sheet.Cells(index, dateColumn).Value = ParametricVar / AuM
        sheet.Cells(index, dateColumn + 2).Value = AuM
        sheet.Cells(index, dateColumn + 5).Value = Application.WorksheetFunction.Min(Workbooks(wb).Worksheets("VaR Comparison").Range("P11:AA11"))
        sheet.Cells(index, dateColumn + 6).Value = Application.WorksheetFunction.Max(Workbooks(wb).Worksheets("VaR Comparison").Range("J16:J1000"))

        wb.Close Savechanges:=False
    Next index
End Sub

1 个答案:

答案 0 :(得分:1)

我个人将您的portfolioDate保留为字符串,然后检查返回的内容(我将InputBox变量重命名为portfolioInputBox)。我将所有这些内容放置在Do循环中,这样,如果用户不取消操作或使用默认输入(“此处输入”)按OK,它将一直打开直到输入有效日期为止。 >

Dim portfolioInputBox As String

Do
    portfolioInputBox = InputBox("Please enter date under the following form : YYYY-MM", "Date at the time of Stress Test", "Type Here")

    If portfolioInputBox = "Type Here" Or portfolioInputBox = vbNullString Then Exit Sub
Loop Until IsDate(portfolioInputBox)

这里有If语句,用于测试用户是否刚刚单击了默认文本并单击“确定”,或者单击了“取消”,这两者中的任何一个都将退出Sub

然后我将使用另一个变量,将portfolioInputBox输入转换为日期格式

Dim portfolioDate as Date
portfolioDate = cDate(portfolioInputBox)

然后我将使用此变量来计算上个月或将其一行处理

portfolioDate = DateAdd("M", -1, CDate(portfolioInputBox))