title image


Smiley Re: Umrechnen mehrerer Zellenwerte von DM auf EUR?
Habe dies mittels VBA wie folgt gelöst:Const Umrechnung = 1.95583Const Dezimalstellen = 0Sub Euro2DM()   Call Berechnen("EUR")End SubwSub DM2Euro()   Call Berechnen("DM")End SubFunction Berechnen(Richtung)   Static Stellen   If Workbooks.Count = 0 Then      MsgBox "Bitte öffnen Sie zunächst eine Datei !", vbExclamation, "Hinweis"      End   End If   Set Bereich = Application.Selection   nochmal:   If Stellen = "" Then Stellen = 2   Stellen = InputBox("Anzahl der Dezimalstellen ?", "Eurokonverter", Stellen)   If Stellen = "" Then Exit Function   If Not IsNumeric(Stellen) Then      MsgBox "Fehlerhafte Dezimalstellen !" & Chr(13) & "Es sind nur numerische Werte zulässig !", vbCritical, "Hinweis", "", 0      GoTo nochmal    End If    If Stellen        MsgBox "Fehlerhafte Dezimalstellen !" & Chr(13) & "Der Wert muß größer 0 sein !", vbCritical, "Hinweis", "", 0       GoTo nochmal    End If    If Stellen > 100 Then        MsgBox "Fehlerhafte Dezimalstellen !" & Chr(13) & "Zuviele Dezimalstellen !", vbCritical, "Hinweis", "", 0        GoTo nochmal    End If   If Stellen = 0 Then      f = "0"   Else      For X = 1 To Stellen         f = f & "0"      Next      f = "#,##0." & f   End If   Verarbeitet = 0   Gesamt = Bereich.Cells.Count   For Each Zelle In Bereich.Cells      Verarbeitet = Verarbeitet + 1       Fertig = CInt((100 / Gesamt) * Verarbeitet)       Application.StatusBar = Fertig & " % verarbeitet"       s = Zelle.Value       If IsNumeric(s) Then          If s "" Then             If Richtung = "EUR" Then                'nur Umrechnen, wenn keine Formel !               If Not ActiveCell.HasFormula Then s = s / Umrechnung               Zelle.NumberFormat = f & " €"             Else               'nur Umrechnen, wenn keine Formel !               If Not ActiveCell.HasFormula Then s = s * Umrechnung               Zelle.NumberFormat = f & " $"            End If         If Not ActiveCell.HasFormula Then         Zelle.Value = s      Else           Msgbox "Zelle " & Zelle.Address & " beinhaltet eine Formel" & Chr(13) & "und wurde nur formatiert !"      End With     End If    End If   End If Next Zelle Application.StatusBar = FalseEnd Function 

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: