Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Průniky intervalů - Excel

Nedal si sem príklad, ako vyzerá tvoj zošit, takže predpokladám, že tam máš niekde tabuľku so zoznamom jázd (aInputRangeAddress) a potom tabuľku so zoznamom dátumov, pre ktoré chceš vypočítať počet áut (aOutputRangeAddress). Makro by mohlo vyzerať napríklad takto (konštanty si musíš upraviť podľa seba):

Const aInputRangeAddress = "A1:C5"
Const aInputDateColumn = 1
Const aInputStartTimeColumn = 2
Const aInputEndTimeColumn = 3
Const aOutputRangeAddress = "E1:F2"
Const aOutputDateColumn = 1
Const aOutputCountColumn = 2

Sub CountCars()
    Dim aStartTime As Variant
    Dim aEndTime As Variant
    Dim aInputRange As Range
    Dim aRow As Range
    
    aStartTime = WorksheetFunction.Min(aInputRange.Columns(aInputStartTimeColumn))
    aEndTime = WorksheetFunction.Max(aInputRange.Columns(aInputEndTimeColumn))
    Set aInputRange = Range(aInputRangeAddress)
    For Each aRow In Range(aOutputRangeAddress)
        aRow.Columns(aOutputCountColumn).Value = CountCollisions(aInputRange, _
            aInputRange.Row, aRow.Columns(aOutputDateColumn).Value, aStartTime, aEndTime)
    Next aRow
End Sub

Function CountCollisions(aInputRange As Range, aRowIndex As Integer, aDate As Variant, aStartTime As Variant, aEndTime As Variant)
    Dim aRow As Range
    Dim aCollisions As Integer
    
    CountCollisions = 0
    For Each aRow In aInputRange.Rows
        If aRow.Row >= aRowIndex And _
                aRow.Columns(aInputDateColumn) = aDate And _
                aRow.Columns(aInputStartTimeColumn) < aEndTime And _
                aRow.Columns(aInputEndTimeColumn) > aStartTime Then
            aCollisions = 1 + CountCollisions(aInputRange, aRow.Row + 1, aDate, _
                WorksheetFunction.Max(aStartTime, aRow.Columns(aInputStartTimeColumn)), _
                WorksheetFunction.Min(aEndTime, aRow.Columns(aInputEndTimeColumn)))
            If aCollisions > CountCollisions Then CountCollisions = aCollisions
        End If
    Next aRow
End Function

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny