Hallo,
in der zuvor geannten Lösung werden die Summen nicht blockweise gebildet, sondern insgesamt.
Mit dieser Lösung erfolgt die Summenbildung wie gewünscht pro Block:
Zeitschritt |
Überschuß/Mangel |
Zeitraum |
1 |
-1 |
3 |
1 |
-2 |
3 |
1 |
-5 |
3 |
1 |
2 |
1 |
1 |
-8 |
2 |
1 |
-3 |
2 |
1 |
7 |
2 |
1 |
8 |
2 |
Berechnete Spalte "Zeitraum":
C2: =BlockRowsCount(A:B;B2)
Verwendeter VBA-Code:
Option Explicit
Enum SIGNValue
Positive = True
Negative = False
NotNumeric = -2
End Enum
Function BlockRowsCount(DatabaseRange As Range, valueRow As Range) As Integer
Dim dblRow As Double
Dim SignCurr As SIGNValue
Dim iCnt As Integer
SignCurr = getSign(DatabaseRange, valueRow.Row)
If Not SignCurr = SIGNValue.NotNumeric Then
' Suchen Block-Beginn
dblRow = valueRow.Row + 1
iCnt = -1
Do
dblRow = dblRow - 1
iCnt = iCnt + 1
Loop While dblRow > 1 And getSign(DatabaseRange, dblRow - 1) = SignCurr
' Suchen Block-Ende
dblRow = valueRow.Row - 1
Do
iCnt = iCnt + 1
dblRow = dblRow + 1
Loop While dblRow <= DatabaseRange.Rows.Count + wrapper(DatabaseRange).Row - 1 And getSign(DatabaseRange, dblRow + 1) = SignCurr
Else
iCnt = 0
End If
BlockRowsCount = iCnt
End Function
''' <summary>
''' Auslesen des Vorzeichens eines Datenbank-Eintrags
''' </summary>
''' <parameters name="DatabaseRange">Datenbankbereich</parameters>
''' <parameters name="dblRow">Auszulesende Zeile</parameters>
''' <returns>
''' Type: SIGNValue
''' Positive = positive Zahl
''' Negative = negative Zahl
''' NOTNumeric = kein Numerischer Wert
''' </returns>
Private Function getSign(DatabaseRange As Range, dblRow As Double) As SIGNValue
Dim varValue As Variant
varValue = DatabaseRange.Cells(dblRow - wrapper(DatabaseRange).Row + 1, 2).Value
If IsNumeric(varValue) And Not IsEmpty(varValue) Then
getSign = IIf(CBool(Abs(varValue) = varValue), SIGNValue.Positive, SIGNValue.Negative)
Else
getSign = SIGNValue.NotNumeric
End If
End Function
''' <summary>
''' Ermittelt die Anfangszelle eines Ranges
''' </summary>
''' <parameters name="current">Ausgangs-Range-Object</parameters>
''' <returns>
''' Typ: Range
''' Erste Zelle oben links wird zurückgeliefert
''' </returns>
Private Function wrapper(current As Range) As Range
Set wrapper = Sheets(current.Parent.Name).Cells(current.Cells(1).Row, current.Cells(1).Column)
End Function
Erläuterung:
Die Funktion BlockRowsCount prüft ob die aktuelle Zeile eine Numerische Zahl beinhaltet.
Falls hier keine Zahl vorhanden ist, wird "0" zurückgeliefert.
Andernfalls werden weitere Zeilen oberhalb und unterhalb geprüft, ob hier ebenfalls eine Zahl mit gleichem Vorzeichen eingetragen wurde. Die Anzahl wird schließlich zurückgegeben.
VG, BigBen
|