Question

我创建了VBA代码，该代码会根据特定日期和投资组合自动将其他工作簿中的数据复制到活动工作表中。

我已成功复制了所需的所有信息，但是我缺少了两部分。

我想在另一个工作簿（我使用For循环打开）的某个范围内找到最小值，然后将其复制到活动工作表中。打开的工作簿中另一个范围的最大值也是如此。

以下是我到目前为止的代码。

Application.Max(Workbooks(portfolioName).Worksheets("VaR Comparison").Range("J16:J1000"))

函数只是返回零值。

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 portfolioDate As String
Dim portfolioName As Variant
Dim ParametricVar As Double
Dim AuM As Double
Dim PreviousVar As Double
Dim PreviousAuM 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 = 26 To Cells(Rows.Count, "B").End(xlUp).Row    
  dateColumn = MatchHeader(portfolioDate)
  portfolioName = ActiveSheet.Range("B" & 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")
  PreviousVar = sheet.Cells(index, dateColumn + 7).Value
  PreviousAuM = sheet.Cells(index, dateColumn + 9).Value

  sheet.Cells(index, dateColumn).Value = ParametricVar / AuM
  sheet.Cells(index, dateColumn + 2).Value = AuM
  sheet.Cells(index, dateColumn + 1).Value = (ParametricVar - PreviousVar) / PreviousVar
  sheet.Cells(index, dateColumn + 3).Value = (AuM - PreviousAuM) / PreviousAuM

  sheet.Cells(index, dateColumn + 5).Value = Application.Min(Workbooks(portfolioName).Worksheets("VaR Comparison").Range("P11:AA11"))
  sheet.Cells(index, dateColumn + 6).Value = Application.Max(Workbooks(portfolioName).Worksheets("VaR Comparison").Range("J16:J1000"))

  wb.Close Savechanges:=False

Next index

End Sub

Answer 1

修改并尝试：

 Sub test()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range

    Dim Max As Double, Min As Double

    'Set the workbook
    Set wb = Workbooks("Book1")
    'Set the worksheet
    Set ws = wb.Worksheets("Sheet1")
    'Set range
    Set rng = ws.Range("A1:A10")

    Max = Application.WorksheetFunction.Max(rng)
    Debug.Print Max
    Min = Application.WorksheetFunction.Min(rng)
    Debug.Print Min

End Sub

Answer 2

答案之一很好。

如果您只想添加几行，可以尝试最少的行：

ActiveCell.FormulaR1C1 = "=MIN(R[1]C[-9]:R[37]C[-2])"
Range("CELL YOU WANT IT IN").Select

最大：

ActiveCell.FormulaR1C1 = "=MAX(R[1]C[-11]:R[37]C[-4])"
Range("CELL YOU WANT IT IN").Select

如何找到另一个工作簿中的范围的最大值和最小值？

2 个答案: