kleiner VBA Code Teil 2
06.05.2009 10:50:32
Drusilla
Könnte man den Mittelwert nach dem Nuller-Löschen einfach nochmals berechnen und drüber schreiben? Oder vor dem Löschen einfach irgendeine Zahl in die letzte Zeile schreiben, dann Nullen löschen und dann Mittelwert berechnen und die Zahl von vorhin überschreiben?
Hier nochmals der Code:
Option Explicit
Sub Output_Standard()
Dim Ws As Worksheet
Dim lngzeile As Long
Dim strDatNam As String
Application.ScreenUpdating = False
With ActiveWorkbook
'Sicherheitsabfrage:
If MsgBox("Soll die Datei " & .Name & " bearbeitet werden?", vbYesNo) = vbNo Then
GoTo Ende
End If
For Each Ws In .Worksheets
With Ws
If .Name "Titelblatt" Then 'Titelblatt übergehen
'Fixierung aufheben:
.Activate
ActiveWindow.FreezePanes = False
'Spalten einblenden
.Range(.Cells(1, 1), .Cells(1, Columns.Count)).EntireColumn.Hidden = False
'Zeilen einblenden:
.Range(.Cells(1, 1), .Cells(Rows.Count, 1)).EntireRow.Hidden = False
'Mittelwert ausgeben:
lngzeile = .Cells(.Rows.Count, 10).End(xlUp).Row
.Cells(lngzeile + 2, "J").Value = _
Application.WorksheetFunction.Average(.Range(.Cells(4, 10), .Cells( _
lngzeile, 10)))
'Zeilen löschen wenn in Spalte J (Kosten) der Zellwert = 0 ist (löscht auch _
Leerzeilen)
For lngzeile = .Cells(.Rows.Count, "J").End(xlUp).Row To 4 Step -1
If .Cells(lngzeile, 10).Value = 0 Then
.Rows(lngzeile).Delete
End If
Next
End If
End With
Next 'nächstes Tabellenblatt
'Speichern
ActiveWorkbook.SaveAs Filename:="24h.xls"
Set Ws = Nothing
End With
Ende:
Application.ScreenUpdating = True
Set Ws = Nothing
End Sub
Vielen Dank!!