VBA - 从最大范围设置范围

时间:2017-11-02 15:37:00

标签: excel vba excel-vba

我想知道在使用WorksheetFunction.Max功能后是否有办法设置范围。因此,如果范围max是12/31/2015,我可以将值还原回单元格范围,即"D10"。这是我到目前为止的代码。

Sub NetValue()

Dim lngLastRow As Long, rngCell As Range, rngRange As Range, _
lngMin As Long, lngMax As Long, lngPreviousRow As Long, _
raw As Worksheet, data As Worksheet, dLRow As Double, endDate As Double, _
r As Range, n As Long

lngLastRow = lastRow(column_to_check:=2)

Set raw = Worksheets("Raw")
Set data = Worksheets("Data")
Set rngRange = raw.Range(raw.Cells(2, 1), raw.Cells(lngLastRow + 1, 1))
dLRow = data.Range("A1", data.Range("A1").End(xlDown)).Rows.Count

raw.Range("J:J").EntireColumn.Insert
raw.Range("C:E").EntireColumn.NumberFormat = "mm/dd/yyyy"

For Each rngCell In rngRange

    If Len(rngCell) > 0 Then

        If lngPreviousRow > 0 And (rngCell.Row - 1 <> lngPreviousRow) Then
            raw.Cells(lngPreviousRow, 10) = s.Cells(n).Offset(0, 6)
        End If

        If (rngCell.Row = 1) Or lngPreviousRow = (rngCell.Row - 1) Then
            Set r = raw.Range(rngCell.Offset(0, 1), rngCell(0, 2))
            Set s = raw.Range(rngCell.Offset(0, 2), rngCell(0, 3))
            lngMin = WorksheetFunction.Min(r)
            lngMax = WorksheetFunction.Max(s)
            m = Application.Match(lngMin, r, 0)
            n = Application.Match(lngMax, s, 0)
            raw.Cells(rngCell.Row, 10) = s.Cells(n).Offset(0, 6)
        End If

        lngPreviousRow = rngCell.Row
        Set r = raw.Range(rngCell.Offset(0, 1), rngCell(0, 2))
        Set s = raw.Range(rngCell.Offset(0, 2), rngCell(0, 3))
        lngMin = WorksheetFunction.Min(r)
        lngMax = WorksheetFunction.Max(s)
        m = Application.Match(lngMin, r, 0)
        n = Application.Match(lngMax, s, 0)

    Else
        Set r = raw.Range(rngCell.Offset(0, 1), rngCell(0, 2))
        Set s = raw.Range(rngCell.Offset(0, 2), rngCell(0, 3))
        lngMin = WorksheetFunction.Min(r)
        lngMax = WorksheetFunction.Max(s)
    End If
Next rngCell

Cells(lngPreviousRow, 10) = s.Cells(n).Offset(0, 6)

End Sub enter image description here

因此,简而言之,根据每份合约的结束日期,我需要最后一个净值Column I

1 个答案:

答案 0 :(得分:1)

根据您的设置,这是一种方法 - 如果不起作用,您应该发布整个代码。 (还要注意非唯一的最大值。)

Dim n As Long, enddate, r As Range

Set r = Range(rngCell.Offset(0, 1), rngCell.Offset(0, 2))
enddate = WorksheetFunction.Max(r)
n = Application.Match(enddate, r, 0)

raw.Cells(rngCell, 10) = r.Cells(n).Offset(0, 5)