[Excel, VBA] letzter Wert eines Zellbereiches (od Zeile, Spalte)
Gepostet am: May 24, 2011 8:42:18 AM
Ermitteln mittels Exel-Formel
Um den letzten Wert eines Zellbereiches der > 0 ist zu ermitteln, kann man die bekannte Frank-Kabel-Lösung verwenden.
> =VERWEIS(2;1/(ZELLBEREICH<>0);ZELLBEREICH)
bzw. für Werte ungleich ""
> =VERWEIS(2;1/(ZELLBEREICH<>"");ZELLBEREICH)
Das ganze hat jedoch folgende Einschränkung - man kann nicht festlegen, dass Zellbereich <> 0 und Zellbereich <> "" ausgewertet wird. (Jedenfalls habe ich noch keine Lösung dafür gefunden)
Ermitteln mittels VBA
letzter Wert eines Zellbereiches
Function letzterWert(myRange As Range) As Double Dim element As Range For Each element In myRange If element.Value <> 0 And element.Value <> "" Then Debug.Print element.AddressLocal & "-" & element.Value letzterWert = element.Value End If NextEnd Function
Bei einzelnen Spalten oder Zeilen ist die Vorgehensweise des Skripts logisch (von oben nach unten, von links nach recht). Aber wie sieht es bei Zellbereichen aus, die sowohl mehrer Zeilen als auch mehrere Spalten haben.
Das mag zwar praktisch sein, wirklich viel damit machen kann man aber noch nicht. Wie sieht es aus, wenn man statt horizontal vertikal auslesen möchte? Was ist wenn man den den 4.letzten Wert haben möchte usw.
Ausgangslage ist folgender Bereich:
Mit der erweiterten Formel kann man dann den Bereich auch folgendermaßen auslesen:
Die Formel dazu:
erweiterte Formel
Function letzterWert(myRange As range, Optional how As Integer = 1, Optional ignoreError As Boolean = True, Optional ignoreEmptyCells As Boolean = True, Optional ignorenull As Boolean = False, Optional Stelle As Integer = 1) As Variant
Dim element As range Dim i As Integer Dim j As Integer Dim counter As Integer counter = 0 Dim myArray() As Variant Dim bIgnore As Boolean Dim returnValue As Variant If how = 1 Then Debug.Print "Horizontal" For i = 1 To myRange.Rows.Count For j = 1 To myRange.Columns.Count bIgnore = False If IsEmpty(myRange.Cells(i, j).Value) And ignoreError = True Then bIgnore = True End If If IsError(myRange.Cells(i, j).Value) And ignoreEmptyCells = True Then bIgnore = True End If If IsNumeric(myRange.Cells(i, j).Value) Then If (myRange.Cells(i, j).Value = 0) And (ignorenull = True) Then bIgnore = True End If End If If bIgnore = False Then ReDim Preserve myArray(counter) myArray(counter) = myRange.Cells(i, j).Value returnValue = myRange.Cells(i, j).Value counter = counter + 1 End If Next Next ElseIf how = 2 Then Debug.Print "Vertikal" For i = 1 To myRange.Columns.Count For j = 1 To myRange.Rows.Count bIgnore = False If IsEmpty(myRange.Cells(j, i).Value) And ignoreError = True Then bIgnore = True End If If IsError(myRange.Cells(j, i).Value) And ignoreEmptyCells = True Then bIgnore = True End If If IsNumeric(myRange.Cells(j, i).Value) Then If (myRange.Cells(j, i).Value = 0) And (ignorenull = True) Then bIgnore = True End If End If If bIgnore = False Then ReDim Preserve myArray(counter) myArray(counter) = myRange.Cells(j, i).Value returnValue = myRange.Cells(j, i).Value counter = counter + 1 End If Next Next Else returnValue = CVErr(xlErrNA) End If If Stelle = 1 Then letzterWert = returnValue Else Dim number As Integer number = UBound(myArray) + 1 letzterWert = myArray(number - Stelle) End IfEnd Function
Damit kann man nun eine Menge anstellen. Hier ein paar Beispiele:
