Question

我无法弄清楚如何用开始日期减去合同的结束日期。但是，我无法弄清楚如何引用初始日期。。

例如，=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

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

但是，让我们想象所有日期实际上都是数字（在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次，为他们构建单独的功能是个好主意。
只需使用字典，就会给出更清晰的解决方案。字典应该包含一个有两个位置的数组，一个用于最小值，一个用于最大值。但它并不像上面那样有趣。

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

VBA - 减去不同的日期

2 个答案: