VBA - 减去不同数量的日期

我无法弄清楚如何用开始日期减去合同的最终日期。但是，我无法弄清楚如何引用最初的日期。。例如，=D2 - C2以及能够做=D10 - C5。这是我目前所拥有的，而且根本不起作用。VBA - 减去不同数量的日期

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

任何方向将不胜感激，由于提前。

来源

2017-08-31 A Cohen

对于每个合同，总是开始和结束日期升序排列？ – SJR

您是否必须为此使用VBA？您是否想要从每个文档的最后结束日期找出持续时间（SLA结束 - SLA开始）？ – ian0411

是的，它们总是按升序排列。是的，我想使用VBA，因为我将这样计算数千个数据。 –

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

然而，让我们想象一下，所有的日期实际上是数字那么你的投入可以转换为这样的事情（和Excel他们！）：

现在什么都想是让在列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次，这将是建立一个独立的功能对他们来说是个好主意。
只需使用一个字典，它会给出一个更清晰的解决方案。字典应该包含两个位置的数组，一个用于最小值，另一个用于最大值。但它不如上述那样有趣。

来源

2017-08-31 14:19:17 Vityata

它适用于大多数人，但我遇到的问题是在合同开始和结束日期之间只有一年的时间间隔。示例是第一行数据 –

@ACohen - 如果删除输入数据的第一行，例如'销售单据'，'SLA'等，你仍然会遇到问题吗？ – Vityata

我引用'行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

来源

2017-08-31 14:25:44 SJR

VBA - 减去不同数量的日期

回答

相关问题