VBA – 减去不同数量的date

我很难弄清楚如何用开始date减去合同的最后date。 但是，我无法弄清楚如何引用最初的date。 。

例如， =D2 - C2以及能够做=D10 - C5 。 这是我目前所拥有的，而且根本不起作用。

 Dim sla As Long, slacnt As Long, drng As Long, i As Long i = 2 With Worksheets("Raw") slacnt = .Cells(.rows.Count, 2).End(xlUp).Row For sla = i To slacnt drng = Sheets("Data").Range("B" & i).Value If .Range("B" & i) <> .Range("B" & i).Offset(1, 0) Then Else: drng = .Range("D" & i).Value - .Range("C" & i).Value End If Next sla End With 

任何方向将不胜感激，在此先感谢。

Answer 1

这将是一个完美的问题，用字典来解决，但不知怎的，我懒得这样做。

然而，让我们想象所有的date实际上是数字（在Excel中它们是！），那么你的input可以被翻译成这样的东西：

现在想要的是在列D中的列A中的每个值和列E中的最大值中获得最小值。我已经实现了以下内容：

代码如下所示：

 Option Explicit Sub TestMe() Dim lngLastRow As Long Dim rngCell As Range Dim rngRange As Range Dim lngMin As Long Dim lngMax As Long Dim lngPreviousRow As Long Dim ws As Worksheet lngLastRow = lastRow(column_to_check:=2) Set ws = ActiveSheet Set rngRange = ws.Range(ws.Cells(1, 1), ws.Cells(lngLastRow, 1)) For Each rngCell In rngRange If Len(rngCell) > 0 Then If lngPreviousRow > 0 And (rngCell.Row - 1 <> lngPreviousRow) Then ws.Cells(lngPreviousRow, 4) = lngMin ws.Cells(lngPreviousRow, 5) = lngMax End If If (rngCell.Row = 1) Or lngPreviousRow = (rngCell.Row - 1) Then ws.Cells(rngCell.Row, 4) = WorksheetFunction.Min(rngCell.Offset(0, 1), rngCell.Offset(0, 2)) ws.Cells(rngCell.Row, 5) = WorksheetFunction.Max(rngCell.Offset(0, 1), rngCell.Offset(0, 2)) End If lngPreviousRow = rngCell.Row lngMin = WorksheetFunction.Min(rngCell.Offset(0, 1), rngCell.Offset(0, 2)) lngMax = WorksheetFunction.Max(rngCell.Offset(0, 1), rngCell.Offset(0, 2)) Else lngMin = WorksheetFunction.Min(lngMin, rngCell.Offset(0, 1), rngCell.Offset(0, 2)) lngMax = WorksheetFunction.Max(lngMax, rngCell.Offset(0, 1), rngCell.Offset(0, 2)) End If Next rngCell Cells(lngPreviousRow, 4) = lngMin Cells(lngPreviousRow, 5) = lngMax End Sub Function lastRow(Optional strSheet As String, Optional column_to_check As Long = 1) As Long Dim shSheet As Worksheet If strSheet = vbNullString Then Set shSheet = ActiveSheet Else Set shSheet = Worksheets(strSheet) End If lastRow = shSheet.Cells(shSheet.Rows.Count, column_to_check).End(xlUp).Row End Function 

改进点：

• WorksheetFunction.Min和WorksheetFunction.Max重复3次，这是一个好主意，为他们build立一个单独的function。
• 只要用字典，就会给出一个更清晰的解决scheme。 字典应该包含两个位置的数组，一个用于最小值，另一个用于最大值。 但它不如以上那样有趣。

Answer 2

Vityata已经打败了我，但是我开始这个，所以不妨把它贴出来。

 Sub x() Dim r As Range, r1 As Range, a, b With Worksheets("Raw") Set r1 = .Range("A2", .Range("D" & Rows.Count).End(xlUp)) End With With r1.Columns(1) .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" For Each r In .SpecialCells(xlCellTypeConstants) a = Evaluate("MIN(IF(" & .Address & "=" & r & ",IF(" & r1.Columns(3).Address & "<>""""," & r1.Columns(3).Address & ")))") b = Evaluate("MAX(IF(" & .Address & "=" & r & "," & r1.Columns(4).Address & "))") r.Offset(, 4) = b - a Next r .SpecialCells(xlCellTypeFormulas).ClearContents End With End Sub