VBA - 从范围2中的最大值设置范围

时间:2017-11-08 14:49:26

标签: excel vba excel-vba

我编辑了我的orignal post,它似乎在大部分时间都在工作,但仅限于合同,后续合同它会从最后一个数字开始,而不是最后一个数字。它也不适用于一线合约,即。 1年。这仅适用于第一份合同。

后续合同由Column A区分。新合同号开始的地方。目标是为每个合约提供Column I的最后一个值。例如,作为区域A11:L15的合同,J11中的值应等于I15中的值。对于以后的合同,这应该是正确的,包括在第二张图像中只有一年的合同,如A126

Top One Year

如果有人有任何建议,我们将不胜感激。

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)

2 个答案:

答案 0 :(得分:1)

据我所知,您希望合约的第一行显示最后的合约价值。此外,似乎合同描述(列K)对于给定的合同是一致的。如果我正确理解您的问题,只需循环描述以查找更改。然后将值输入到与给定描述相对应的第一个唯一单元格中。

Dim Rng As Range
Set Rng = Range("k2:k146")
Dim NextCell As Range

For Each Cell In Rng
    Set NextCell = Cell
    Do Until NextCell.Text <> Cell.Text
        Set NextCell = NextCell.Offset(1, 0)
    Loop
    Set NextCell = NextCell.Offset(-1, 0)
    If Cell.Offset(-1, 0).Text <> Cell.Text Then
        Cell.Offset(0, -1).Value = NextCell.Offset(0, -2).Value
    End If
Next Cell

答案 1 :(得分:0)

我能够解决它。感谢@ E.Merckx帮助我指明正确的方向。虽然它不是我想要的,但它的目的很好。

Sub NetValue()

Dim lngLastRow As Long, raw As Worksheet, data As Worksheet, rng As Range

lngLastRow = lastRow(column_to_check:=2)

Set raw = Worksheets("Raw")
Set data = Worksheets("Data")
Set rng = raw.Range(raw.Cells(3, 6), raw.Cells(lngLastRow + 1, 6))

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

For Each Cell In rng
    If Cell.Value <> "" Then
        Cell.Offset(-1, 4) = Cell.Offset(-1, 3).Value
    End If
Next Cell

End Sub

Final Product

再次感谢!