VBA – 范围2中的最大范围

我编辑了我的原始邮件 ，似乎大部分工作，但只为合同，随后的合同拉倒数第二，而不是最后一个数字。 也不会为一个线路合同，即。 1年。 这只适用于第一份合同。

随后的合同由Column A区分。 新的合同号码开始的地方。 目标是为每个合同获得第一Column I的最后一个值。 例如，合同是A11:L15的区域， J11的值应该等于I15的值。 对于后来的合同，这应该是真实的，包括只有一年的合同，如第二张图片中的A126

。

如果有人有任何build议，将不胜感激。

 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) 

Answer 1

据我所知，你想要合同的第一行显示最后的合同价值。 此外，合同描述（列K）似乎对于给定的合同是一致的。 如果我正确理解您的问题，只需循环查看说明即可查找更改。 然后将该值input到与给定描述对应的第一个唯一单元格中。

 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 

Answer 2

我能解决它。 感谢@ 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 

再次感谢！