AW: Frage wieder offen
19.09.2006 21:41:14
Philipp
Hallo Ronny
Die Liste der auswählbaren Funktionen lässt sich nicht erweitern, weil es sich um ein fest in Excel integriertes Feature handelt. Man kann aber die Funktionen leicht nachprogrammieren und deren Resultat beispielsweise in der Statuszeile ausgeben.
Füge diesen Code in das Modul 'DieseArbeitsmappe' ein:
Private Sub Workbook_Activate()
Application.StatusBar = CalculateRange(ActiveSheet)
End Sub
Private Sub Workbook_Deactivate()
Application.StatusBar = False
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.StatusBar = CalculateRange(Sh)
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Application.StatusBar = CalculateRange(Sh)
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Application.StatusBar = CalculateRange(Sh)
End Sub
Private Function CalculateRange(ByRef Sh As Object) As Variant
Dim rngRange As Range
Dim strOutput As String
On Error Resume Next
If TypeName(Selection) = "Range" Then
If Selection.Cells.Count > 1 Then
Set rngRange = Sh.Range(Selection.Address)
With Application.WorksheetFunction
strOutput = "Summe: " & .Sum(rngRange)
strOutput = strOutput & "|Mittelwert: " & .Average(rngRange)
If Err.Number <> 0 Then
strOutput = strOutput & "|Mittelwert: #NV"
Err.Clear
End If
strOutput = strOutput & "|Zählen: " & .Count(rngRange)
strOutput = strOutput & "|Anzahl: " & .CountA(rngRange)
strOutput = strOutput & "|Min: " & .Min(rngRange)
strOutput = strOutput & "|Max: " & .Max(rngRange)
strOutput = strOutput & "|Produkt: " & .Product(rngRange)
End With
Set rngRange = Nothing
CalculateRange = strOutput
Else
CalculateRange = False
End If
Else
CalculateRange = False
End If
End Function
Sobald zwei oder mehr Zellen selektiert sind, wird die Funktion CalculateRange aufgerufen, welche die Funktionen Summe, Mittelwert, Zählen, Anzahl, Min, Max und, als zusätzliche Funktion, Produkt der selektierten Zellen des aktiven Blattes berechnet und die Resultate in der Statuszeile ausgibt. Diese Funktion CalculateRange kann beliebig angepasst bzw. erweitert werden.
Grüsse
Philipp von Wartburg
www.xlam.ch