Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
992to996
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
992to996
992to996
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Code optimieren

Code optimieren
17.07.2008 10:14:00
edie
Hallo zusammen,
in den Spalten C bis J wird der Mittelwert berechnet und die letzte Zelle
anschließend formatiert.
Kann der nachfolgende Code optimiert werden? Besonders
die Formatierung der ganzen letzten Zeile.

Sub Mittelwert()
Dim intRow As Integer
intRow = Cells(Rows.Count, 1).End(xlUp).Row
If Cells(intRow, 1).Font.Bold = True Then intRow = intRow - 1
Cells(intRow + 1, 3).Formula = "=Average(C7:C" & intRow & ")"
Cells(intRow + 1, 3).Font.Bold = True
Cells(intRow + 1, 3).NumberFormat = "0.0"
Cells(intRow + 1, 4).Formula = "=Average(D7:D" & intRow & ")"
Cells(intRow + 1, 4).Font.Bold = True
Cells(intRow + 1, 4).NumberFormat = "0.0"
Cells(intRow + 1, 5).Formula = "=Average(E7:E" & intRow & ")"
Cells(intRow + 1, 5).Font.Bold = True
Cells(intRow + 1, 5).NumberFormat = "0.0"
Cells(intRow + 1, 6).Formula = "=Average(F7:F" & intRow & ")"
Cells(intRow + 1, 6).Font.Bold = True
Cells(intRow + 1, 6).NumberFormat = "0.0"
Cells(intRow + 1, 7).Formula = "=Average(G7:G" & intRow & ")"
Cells(intRow + 1, 7).Font.Bold = True
Cells(intRow + 1, 7).NumberFormat = "0.0"
Cells(intRow + 1, 8).Formula = "=Average(H7:H" & intRow & ")"
Cells(intRow + 1, 8).Font.Bold = True
Cells(intRow + 1, 8).NumberFormat = "0.0"
Cells(intRow + 1, 9).Formula = "=Average(I7:I" & intRow & ")"
Cells(intRow + 1, 9).Font.Bold = True
Cells(intRow + 1, 9).NumberFormat = "0.0"
Cells(intRow + 1, 10).Formula = "=Average(J7:J" & intRow & ")"
Cells(intRow + 1, 10).Font.Bold = True
Cells(intRow + 1, 10).NumberFormat = "0.0"
End Sub


Hat jemand eine Idee oder Vorschlag?
Vielen Dank im Voraus.
Grüße

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code optimieren
17.07.2008 10:30:00
Tino
Hallo,
meinst du so, habe Ihn aber nicht getestet.

Sub Mittelwert()
Dim intRow As Long, A As Long
intRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
If Cells(intRow - 1, 1).Font.Bold = True Then intRow = intRow - 1
For A = 3 To 10
Cells(intRow, A).Formula = "=Average(C7:C" & intRow & ")"
Cells(intRow, A).Font.Bold = True
Cells(intRow, A).NumberFormat = "0.0"
Next A
End Sub


Gruß Tino

www.VBA-Excel.de


Ohne Schleife :-)
17.07.2008 10:37:57
Ramses
Hallo Tino
... als zusätzliche Variante
Option Explicit

Sub Mittelwert()
    Dim intRow As Integer
    intRow = Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(intRow, 1).Font.Bold = True Then intRow = intRow - 1
    With Range(Cells(intRow + 1, 3), Cells(intRow + 1, 10))
        .Formula = "=Average(C7:J" & intRow & ")"
        .Font.Bold = True
        .NumberFormat = "0.0"
    End With
End Sub

Gruss Rainer

Anzeige
AW: Ohne Schleife :-)
17.07.2008 10:44:30
UweD
Hallo
liefert aber nicht den gewünschten Mittelwert
Gruß UweD

Schreibfehler :-)
17.07.2008 10:51:00
Ramses
Hallo Uwe.
muss natürlich
.Formula = "=Average(C7:C" & intRow & ")"
heissen
Gruss Rainer

AW: Code optimieren
17.07.2008 10:45:50
edie
Hallo Tino,
danke für die schnelle hilfe.
So sieht jetzt aus, leider wird die Zeile nicht formatiert.

Sub Mittelwert()
Dim intRow As Long, A As Long
intRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
For A = 3 To 10
Cells(intRow + 1, 3).Formula = "=Average(C7:C" & intRow & ")"
Cells(intRow + 1, 4).Formula = "=Average(D7:D" & intRow & ")"
Cells(intRow + 1, 5).Formula = "=Average(E7:E" & intRow & ")"
Cells(intRow + 1, 6).Formula = "=Average(F7:F" & intRow & ")"
Cells(intRow + 1, 7).Formula = "=Average(G7:G" & intRow & ")"
Cells(intRow + 1, 8).Formula = "=Average(H7:H" & intRow & ")"
Cells(intRow + 1, 9).Formula = "=Average(I7:I" & intRow & ")"
Cells(intRow + 1, 10).Formula = "=Average(J7:J" & intRow & ")"
Cells(intRow, A).Font.Bold = True
Cells(intRow, A).NumberFormat = "0.0"
Next A
End Sub


Vielen Dank im Voraus. Vielleich noch eine Idee?
Grüße

Anzeige
AW: Korrektur
17.07.2008 10:54:49
Tino
Hallo,
Korrektur, wegen Formelanpassung.

Sub Mittelwert1()
Dim intRow As Long, A As Long
intRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
If Cells(intRow - 1, 1).Font.Bold = True Then intRow = intRow - 1
For A = 3 To 10
Cells(intRow, A).Formula = "=AVERAGE(R[-" & intRow - 7 & "]C:R[-1]C)"
Cells(intRow, A).Font.Bold = True
Cells(intRow, A).NumberFormat = "0.0"
Next A
End Sub


Gruß Tino

www.VBA-Excel.de


AW: Korrektur
17.07.2008 10:58:00
edie
Hallo Tino,
besten Dank, Du hattest mir schon öfters geholfen.
Code funktioniert, prima.
Grüße

Anzeige
AW: Code optimieren
17.07.2008 10:41:27
UweD
Hallo
so geht es auch.


Option Explicit
Sub Mittelwert()
    Dim intRow As Integer
    intRow = Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(intRow, 1).Font.Bold = True Then intRow = intRow - 1
    Cells(intRow + 1, 3).Formula = "=Average(C7:C" & intRow & ")"
    Cells(intRow + 1, 3).Copy Range(Cells(intRow + 1, 3), Cells(intRow + 1, 10))
    With Range(Cells(intRow + 1, 3), Cells(intRow + 1, 10))
        .Font.Bold = True
        .NumberFormat = "0.0"
    End With
End Sub


Gruß UweD

Anzeige
AW: Code optimieren
17.07.2008 10:43:28
Specke
Hallo edie,

Sub Mittelwert()
Dim intRow As Integer
intRow = Cells(Rows.Count, 1).End(xlUp).Row
If Cells(intRow, 1).Font.Bold = True Then intRow = intRow - 1
for i=3 to 10
Cells(intRow + 1, i).FormulaR1C1 = "=Average(R7C" & i & ":R" & introw & "C" & i & ")"
Cells(intRow + 1, i).Font.Bold = True
Cells(intRow + 1, i).NumberFormat = "0.0"
next i
End Sub


Gruß Specke

AW: An Alle vielen Dank , es funktioniert
17.07.2008 10:52:17
edie
Hallo Ramses,
Hallo UweD,
Hallo Specke,
Vielen herzlichen Dank, alle Codes funktionieren.
Grüße

AW: Code optimieren
17.07.2008 11:10:26
Gerd
Hallo,
noch meinen Senf dazu. :-)

Sub b()
Dim lngRow As Long
lngRow = Cells(Rows.Count, 1).End(xlUp).Row
If Cells(lngRow, 1).Font.Bold = True Then lngRow = lngRow - 1
With Range(Cells(lngRow + 1, 3), Cells(lngRow + 1, 10))
.Cells.FormulaR1C1 = "=Average(R7C:R[-1]C)"
.Cells.Font.Bold = True
.Cells.NumberFormat = "0.0"
End With
End Sub


Grüße Gerd

Anzeige
AW: Code optimieren
17.07.2008 13:57:00
edie
Hallo Gerd,
einfach toll, besten Dank.
Viele Grüße

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige