Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Werte -Multiplizieren und Runden per Makro

60 views
Skip to first unread message

Richard Reif

unread,
Aug 24, 1998, 3:00:00 AM8/24/98
to
Hallo Makro-Freaks
Ich arbeite noch nicht lange in XL97(NT). -Habe folgendes Problem:
Angenommen die Spalte "F" ist mit Werten gefüllt (v. Zelle 5 bis
.../ohneLeerzeile!)
Wie kann ich Werte in dieser Spalte mit einem Faktor ( z.B.: 1,085)
multiplizieren
und das Ergebnis auch gleichzeitig gerundet zurückgeben, (nebendran oder
überschreiben)
wobei die Werte bis 20,00 DM auf 2 Nachkommastellen gerundet ...
>20,--DM bis <= 50,-- auf 0,05 DM ,
>50,-- bis <= 100,-- auf 0,10 DM ,
>100,-- bis <= 500,-- auf 0,50 DM und
>500,-- auf 1,00 DM gerundet sein sollten.
Gibt es eine Chance mit "Bearbeiten- Inhalte Einfügen- Operation Multipl."?
(Ein Makro in Lotus-123 hat diesen Job bisher erledigt.) Da ich in XL- VBA
noch
keine Erfahrung habe brauch ich Eure Unterstützung.
Danke
Richard

Hans W. Herber

unread,
Aug 24, 1998, 3:00:00 AM8/24/98
to
Hallo Richard,

vorausgesetzt, der Faktor befindet sich in Zelle G1, folgendes Makro:

Sub ErhoehenUndFormatieren()
Dim C As Range
Dim i%, lZeile%
lZeile = Cells(Rows.Count, 6).End(xlUp).Row

[g1].Copy
Range("F5:F" & lZeile).PasteSpecial _
Paste:=xlValues, _
Operation:=xlMultiply, _
SkipBlanks:=False, _
Transpose:=False

For i = 5 To lZeile
Set C = Cells(i, 6)
Select Case Cells(i, 6)
Case Is <= 20
C = WorksheetFunction.Round(C, 2)
Case Is <= 50
C = WorksheetFunction.Round(C / 5, 2) * 5
Case Is <= 100
C = WorksheetFunction.Round(C / 10, 2) * 10
Case Is <= 500
C = WorksheetFunction.Round(C / 50, 2) * 50
Case Else
C = WorksheetFunction.Round(C / 100, 2) * 100
End Select
Next i
Application.CutCopyMode = False
End Sub

Bei XL5/7 muß "WorksheetFunction" durch "Application" ersetzt werden.

hans

########################################################
# Herber's Excel-Server - letztes Update: 24.08.98 #
# http://www.herber.de - Microsoft MVP - Excel #
# Neu bei der Freeware: Bundesligatabelle #
# Excel-NG-Autoren: http://www.herber.de/dejanews.htm #
########################################################

Richard Reif <rei...@ina.de> wrote in message
01bdcf47$d535c360$05b3339f@pc00086...

Richard Reif

unread,
Aug 27, 1998, 3:00:00 AM8/27/98
to
Danke Hans !
Das Makro ist super.
Hätte im Eifer des Gefechts fast vergessen mich zu bedanken.
Grüße
Richard :)

Hans W. Herber <her...@herber.de> schrieb im Beitrag
<O5f0rS2...@uppssnewspub04.moswest.msn.net>...

0 new messages