Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.10.2025 13:56:55
Wenn Funktion mit Xverweis oder ähnlich
20.10.2025 10:29:26
Userform Multipage - Page auswählen
19.10.2025 21:57:06
Diagrammpunkte in unterschiedlichen Farben je nach Wert
19.10.2025 18:21:56
Prüfen, ob Bild geladen wurde
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
992to996
992to996
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code optimieren

Forumthread: 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

Anzeige

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


Anzeige
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


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

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

Anzeige
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)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige