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 - 減去不同數量的日期

回答

相關問題