Excel kaufmännisch runden (Formel stehen lassen), über Zellenbereich

Question

Ich habe 2 Makros. Eines rundet eine einzelne Zelle und lässt die Rundungsformel stehen -  gut, wenn sich die zu rundenden Werte ändern, eines, dass Werte in einem markierten Bereich rundet, jedoch ohne, dass die Rundungsformel stehen bleibt. Ich versuchte beide zusammen zu führen, weil dies wohl die interessanteste Variante ist. Leider ohne Erfolg. Kann mir hier jemand Unterstützung leisten?

Makro 1:
Sub RundenBeiBestehenderFormel()
'Rundet die bestehende Formel auf 5 Rappen

    Dim F, F1 As String
    Dim L As Variant
    F = ActiveCell.FormulaR1C1
    L = Len(F)
    F = Right(F, L - 1)
    F1 = "=ROUND((" & F & ")*2,1)/2"
    ActiveCell.FormulaR1C1 = F1

End Sub

Makro 2:
Sub KaufmaennischRunden()
'Rundet alle markierten Zellen kaufmännisch

Dim rngBereich As Range
Dim Zelle As Range

Set rngBereich = Selection

For Each Zelle In rngBereich

    If Zelle <> "" And IsNumeric(Zelle) = True Then

        Zelle = Application.Round((Zelle.Value) * 2, 1) / 2
        Zelle.NumberFormat = "_ * #,##0.00_ ;[Red]_ * -#,##0.00_ ;_ * ""-""??_ ;_ @_ "
    End If

Next Zelle

End Sub

Ich wäre sehr dankbar für Unterstützung.

Liebe Grüsse
Monique

Answer 1

Hallo Monique,

meinst du das etwa so:

Sub Runden()

Dim F As String
Dim F1 As String
Dim L As Variant
Dim rngBereich As Range
Dim rngZelle As Range

Set rngBereich = Selection

For Each rngZelle In rngBereich

  If rngZelle.HasFormula Then
     F = ActiveCell.FormulaR1C1
     L = Len(F)
     F = Right(F, L - 1)
     F1 = "=ROUND((" & F & ")*2,1)/2"
     rngZelle.FormulaR1C1 = F1
     rngZelle.NumberFormat = "_ * #,##0.00_ ;[Red]_ * -#,##0.00_ ;_ * ""-""??_ ;_ @_ "
   Else
    If rngZelle <> "" And IsNumeric(rngZelle) = True Then rngZelle = Application.Round((rngZelle.Value) * 2, 1) / 2
    rngZelle.NumberFormat = "_ * #,##0.00_ ;[Red]_ * -#,##0.00_ ;_ * ""-""??_ ;_ @_ "
  End If
Next rngZelle

Set rngBereich = Nothing
Set rngZelle = Nothing

End Sub

Gruß

M.O.

Answer 2

Hallo M.O.

Wow, das geht ja wie im Winde. Leider ist es noch nicht ganz so, wie ich es brauche.

Stell Dir vor, ich habe in den Zellen H6:H27 alles verschiedene, berechnende Formeln.

Mein Wunschziel ist, dass ich diesen Bereich markiere und alle Zellen mit berechnenden Formeln werden kaufmännisch gerundet, aber so, dass die ursprüngliche Berechnung sichtbar bleibt.

Hast Du nochmals Lust? Ich wäre so froh um dieses Makro.

Herzliche Grüsse

Monique

Answer 3

Hallo Monique,

mit dem folgenden Makro wird die Runden-Formel in die nächste Spalte neben die vorhandene Formel geschrieben:

Sub Runden()

Dim F As String
Dim F1 As String
Dim L As Variant
Dim rngBereich As Range
Dim rngZelle As Range

Set rngBereich = Selection

For Each rngZelle In rngBereich

  If rngZelle.HasFormula Then
     F = rngZelle.Formula
     L = Len(F)
     F = Right(F, L - 1)
     F1 = "=ROUND((" & F & ")*2,1)/2"
     With Cells(rngZelle.Row, rngZelle.Column + 1)
       .Formula = F1
       .NumberFormat = "_ * #,##0.00_ ;[Red]_ * -#,##0.00_ ;_ * ""-""??_ ;_ @_ "
     End With
   Else
    If rngZelle <> "" And IsNumeric(rngZelle) = True Then rngZelle = Application.Round((rngZelle.Value) * 2, 1) / 2
    rngZelle.NumberFormat = "_ * #,##0.00_ ;[Red]_ * -#,##0.00_ ;_ * ""-""??_ ;_ @_ "
  End If
Next rngZelle

Set rngBereich = Nothing
Set rngZelle = Nothing

End Sub

Gruß

M.O.

Answer 4

Danke, viel viel Mal. Das ist für mich eine echte Arbeitserleichterung. Leider zum selber machen etwas too much. Gut gibt es Menschen wie Dich. Ich wünsche Dir eine gute Zeit und danke Dir herzlich.

Monique