Gruppe
Allgemein
Bereich
Berechnen
Thema
Werte um einen vorgegebenen Faktor erhöhen und verschieden runden
Problem
Wie kann ich die Werte in einem vorgegebenen Bereich um einen in Zelle G1 stehenden Faktor erhöhen und je nach Höhe unterschiedlich runden?
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: basMain
Sub ErhoehenUndFormatieren()
Dim rng As Range
Dim dValue As Double
Dim iCounter As Integer, iRow As Integer
Application.ScreenUpdating = False
iRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("C1").Copy
Range("A1:A" & iRow).PasteSpecial _
Paste:=xlValues, _
Operation:=xlMultiply, _
SkipBlanks:=False, _
Transpose:=False
For iCounter = 1 To iRow
dValue = Cells(iRow, 1).Value
Select Case dValue
Case Is <= 20
Cells(iRow, 1) = WorksheetFunction.Round(dValue, 2)
Case Is <= 50
Cells(iRow, 1) = WorksheetFunction.Round(dValue / 5, 2) * 5
Case Is <= 100
Cells(iRow, 1) = WorksheetFunction.Round(dValue / 10, 2) * 10
Case Is <= 500
Cells(iRow, 1) = WorksheetFunction.Round(dValue / 50, 2) * 50
Case Else
Cells(iRow, 1) = WorksheetFunction.Round(dValue / 100, 2) * 100
End Select
Next iCounter
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub