Werte um einen vorgegebenen Faktor erhöhen und verschieden runden

Home Zurück Vor

Download der Beispiel-Arbeitsmappe

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