PDA

Vollständige Version anzeigen : Aufrunden in einem definierten Bereich


N.i.C.o.L.e
17.04.2012, 12:38
Hi Folks,

ich hoffe Ihr könnt mir helfen.

Ich will mit einem Makro in der "Tabelle 2" einen bestimmen Bereich I9:SN509 auf ganze Zahlen aufrunden. Also so aufrunden, dass mit den gerundeten Zahlen weitergerechnet wird. Es soll auch nicht, wenn nichts in den Zellen steht auf 0 aufgerundet werden.

Lg Nicole

chris-kaiser
17.04.2012, 12:41
HI

Sind das reine Zahlen in diesem Bereich oder Zahlen aus Formeln?
Leere Zellen sollen leer bleiben, wenn ich dich richtig versatnden habe, oder?

Sub RoundMeUp()
On Error Resume Next
Dim rng As Range, rngCell As Range
Set rng = Range("I9:SN509")
For Each rngCell In rng.SpecialCells(xlCellTypeConstants, 1)
rngCell.Value = Round(rngCell.Value, 0)
Next
If Err.Number <> 0 Then
MsgBox " keine reinen Zahlen ium Breich I9:SN509 gefunden!, vielleicht sind es ja doch Formeln ;)"
End If
End Sub

hier mal für Zahlen

mücke
17.04.2012, 12:50
Moin Nicole,

warum stellst Du die Frage hier noch mal, wenn Du sie doch schon gestern bei office-loesung.de beantwortet bekommen hast :mad:

16. April 2012 13:43
Danke Daniel funzt.

Lg Nicole

N.i.C.o.L.e
17.04.2012, 13:01
Hi,

@ Chris: es sind Formeln^^

@ Dirk: weil ich festgestellt habe, das wenn die Zellen leer, dann wird auf „Null" aufgerundet

Ich entschuldige mich, dass das zu Irretationen geführt hat.

Lg Nicole

chris-kaiser
17.04.2012, 13:03
hi

SpecialCells(xlCellTypeFormulas, 1)


Sub RoundMeUp()
On Error Resume Next
Dim rng As Range, rngCell As Range
Set rng = Range("I9:SN509")
For Each rngCell In rng.SpecialCells(xlCellTypeFormulas, 1)
rngCell.Value = Round(rngCell.Value, 0)
Next
If Err.Number <> 0 Then
MsgBox " keine Formeln im Bereich I9:SN509 gefunden."
End If
End Sub

EarlFred
17.04.2012, 13:11
Hallo Nicole,

zu Irretationen geführt
wer redet hier von "Irritationen"? Crossposting ist schlichtweg nicht erwünscht: Netiquette: Crosspost (http://www.ms-office-forum.net/forum/vbseiten.php?page=3)

Grüße
EarlFred

N.i.C.o.L.e
17.04.2012, 13:19
Hi Chris,

ich vergaß zu schreiben, das die Formeln mittels eines Makros ausgeführt werden. Also deine erste Annahme war richtig, das es sich um ganze Zahlen handelt. Problem ist, das nicht alle überprüften Zellen einen Wert haben. Gibt deine MessageBox deshalb die Ausgabe?

Lg Nicole

N.i.C.o.L.e
17.04.2012, 13:25
Danke für den Rüffel.

Ich werde es zukünftig unterlassen.

Entschuldigung.

Lg Nicole

chris-kaiser
17.04.2012, 13:50
Hi

ich vergaß zu schreiben, das die Formeln mittels eines Makros ausgeführt werden

zzz, dann würde ich ja gleich in DIESEM Makro die Ausgabe wie gewünscht machen.

Warum zuerst etwas unerwünschtes erzeugen und danach wieder "zurechtmurksen", ich sehe darin keinen Sinn. :rolleyes:

Nur wie sieht dieses (dein) Makro aus?

N.i.C.o.L.e
17.04.2012, 14:10
Hi Chris,

recht haste.




Dim z As Long, Zeile As Long
Dim s1 As Long, s2 As Long, sp As Long
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Worksheets("Tabelle1")
Set ws2 = Worksheets("Tabelle2")

Zeile = 9
s1 = 4
s2 = 9

For sp = 1 To 500
For z = 3 To ws1.Cells(Rows.Count, 3).End(xlUp).Row
ws2.Cells(Zeile, s2) = (ws1.Cells(z, 3) * ws1.Cells(z, s1)) / 60
Zeile = Zeile + 2
Next
s1 = s1 + 1
s2 = s2 + 1
Zeile = 9
Next



Lg Nicole

chris-kaiser
17.04.2012, 14:19
Hi

so?

Dim z As Long, Zeile As Long
Dim s1 As Long, s2 As Long, sp As Long, erg As Double
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Worksheets("Tabelle1")
Set ws2 = Worksheets("Tabelle2")

Zeile = 9
s1 = 4
s2 = 9

For sp = 1 To 500
For z = 3 To ws1.Cells(Rows.Count, 3).End(xlUp).Row
erg = (ws1.Cells(z, 3) * ws1.Cells(z, s1)) / 60
ws2.Cells(Zeile, s2) = IIf(erg <> 0, Round(erg, 0), "")
Zeile = Zeile + 2
Next
s1 = s1 + 1
s2 = s2 + 1
Zeile = 9
Next

N.i.C.o.L.e
17.04.2012, 14:30
Hi Chris,

ja,bis auf das Aufrunden. Jetzt wird nur gerundet, mal auf mal ab.
Habe hinter dem Round noch das Up gesetzt, aber da kommt nur "Sub oder Function nicht definiert".

Lg Nicole

EarlFred
17.04.2012, 14:37
Hallo Nicole,

Habe hinter dem Round noch das Up gesetzt
...dann setz noch das Application. davor - dann sollte es klappen:

Application.RoundUp(...)

Grüße
EarlFred

N.i.C.o.L.e
17.04.2012, 14:43
Hi EarlFred,

das hat noch gefehlt, jetzt funzt es.

Danke für eure Hilfe.

Lg Nicole

Hanjo15
15.07.2015, 16:45
Hey,

ich habe den Code von chris-kaiser in meinem Makro eingebaut und dieser funktioniert auch soweit ganz gut. Aber nun muss ich das Arbeitsblatt schützen und lasse nur ein paar Bereiche heraus, in die mein Makro dann auch schreiben wird. Der Rest wie Tabellenkopf und andere Excelberechnung sind ebenfalls geschützt.

Wenn ich mein Makro starte-inkl. dem Aufrunden- dann gibt er mir einen Laufzeitfehler 1004 an der Stelle "For Each rngCell ....". Allerdings ist der aufzurundende Bereich gar nicht gesperrt. Wenn ich das Blatt ungeschützt lasse, funktioniert alles wunderbar.

Hat da jemand eine Idee? Ich glaub ich habe da ein Verständnisproblem oder so?

P.S. Ich habe den Problembereich einmal im Code angehängt.

Danke für eure Hilfe.


Sub Aufrunden()

Dim rngAufrunden As Range, rngCellAufrunden As Range
Set rngAufrunden = Range("S14:AB14")

'immer Aufrunden der Standardabweichung mit einer Nachkommastelle
For Each rngCellAufrunden In rngAufrunden.SpecialCells(xlCellTypeConstants, 1)
rngCellAufrunden.Value = WorksheetFunction.RoundUp(rngCellAufrunden.Value, 1)
Next
If Err.Number <> 0 Then
MsgBox "keine reinen Zahlen im Rundungsbereich gefunden!"
End If
End Sub

chris-kaiser
16.07.2015, 06:03
Hi,

Sub Aufrunden()
ActiveSheet.Protect "Test" , Userinterfaceonly:=true
'............

mit "Test" ist dein Passwort gemeint falls du eines gesetzt hast, 'anpassen!

Hanjo15
16.07.2015, 11:19
Hey,

vielen Dank für die Antwort.

Ich habe deinen Vorschlag etwas abgeändert, da ich trotz der Sperren auf ein Diagramm zugreifen lassen muss.

Sub Aufrunden()
ActiveSheet.Unprotect "pwd"
....
...

ActiveSheet.Protect "pwd", DrawingObjects:=False, Userinterfaceonly:=True
End Sub

Jetzt stellt sich mir nur noch eine Verständnisfrage. Vor und nach dem Makro sind die Zellen des Tabellenblattes geschützt - bei Auswahl gesperrt -. Was ist denn wenn das Makro vor dem Ende gestoppt wird?

Dann müssten die Zellen ja ungeschützt sein und das möchte ich nicht.
Meine Idee wäre dann:


Sub Aufrunden

ActiveSheet.Unprotect "pwd"
On Error GoTo Fehler

....
....
ActiveSheet.Protect "pwd", DrawingObjects:=False, Userinterfaceonly:=True

Fehler:
MsgBox Err.Description
ActiveSheet.Protect "pwd", DrawingObjects:=False, Userinterfaceonly:=True

End Sub

Oder gibt es da vielleicht eine bessere oder elegantere Lösung?

Danke im Voraus!

chris-kaiser
16.07.2015, 11:46
Hi,

das passt schon!

Hanjo15
16.07.2015, 11:54
Okay, dann mache ich das so. Danke!

Hanjo15
17.07.2015, 12:22
Hallo, das Makro funktioniert nun soweit sehr gut. Allerdings habe ich noch eine Eigenart gefunden, die ich noch nicht verstehe.

Ich möchte ja in bestimmten Zellen in meinem Arbeitsblatt Werte aus anderen Messwertedateien einfügen lassen. Damit ich sicher gehe, dass nicht irgendwelche vorherigen Werte noch in den Bereichen stehen, lösche ich diese zuvor mit *.Range("XX:XX").ClearContents.

Wenn ich das Makro normal ausführe, funktioniert es. Aber wenn ich das Makro im Einzelschritt durchlaufen lasse, erhalte ich einen Fehler von Excel (Eine Formel enthält einen oder mehrere ungültige Bezüge...) beim Abarbeiten der ClearContents Anweisungen. Dies geschieht aber nur, wenn die Bereiche gesperrt sind.

Ich dachte, wenn ich dem Makro per PW Zugriff gebe, sollte das funktionieren.

Hier noch mal der Code:

Sub EinlesenMW()

Dim .....

ActiveSheet.Unprotect "pwd"
On Error GoTo Fehler
Application.ScreenUpdating = False

'Alte Zellinhalte löschen
ActiveSheet.Range("S7:AB7").ClearContents
ActiveSheet.Range("S8:AB14").ClearContents
ActiveSheet.Range("S16:AB20").ClearContents
ActiveSheet.Range("D27:P36").ClearContents

.....
End Sub