XL 2016 Conversion en devise

cp4 à dit:

Re,

Une autre approche hyper-rapide. Tout comme ma 1ère proposition, j'ai supposé que les plages à convertir sont fixes.

Cliquez pour agrandir...

sylvanu à dit:

Mais le résultat des courses ?
Est ce que ça correspond à ce que vous attendez ?

Cliquez pour agrandir...

laurent950 à dit:

Bonsoir @cp4 , @sylvanu

Votre code est bien @cp4
J'ai changé les plages en fixe et plage variable.

ici :
If Not c.HasFormula = True And c.Value <> Empty Then
si la cellule contient une formule cela n'a aucune action sur cette cellule
si les cellules sont vide alors rien a faire
Il y a des erreurs de formules dans ce tableau donc pour évité de modifié les cellules et les bug
sur ces cellules j'ai utilisé cela
On Error Resume Next

VB:

Option Explicit
Dim t As Double
Sub Euro()
    t = Timer
    If ActiveSheet.Range("E1") = "EURO" Then Exit Sub
    EuroRon "EURO"
End Sub
Sub Ron()
    t = Timer
    If ActiveSheet.Range("E1") = "RON" Then Exit Sub
    EuroRon "RON"
End Sub
Private Sub EuroRon(ByRef Monnaie As String)
Dim f As Worksheet
    Set f = Worksheets(ActiveSheet.Name)
Dim Devise As Double
    Range("E1") = Monnaie
Dim r, c As Range
    Set r = f.Range(f.Cells(6, 4), f.Cells(f.Cells(65536, 2).End(xlUp).Row, 16))
    On Error Resume Next
    For Each c In r
        If Not c.HasFormula = True And c.Value <> Empty Then
            c.Value = IIf(f.Range("E1").Value = "EURO", c.Value / 5, c.Value * 5)
        End If
    Next c
    On Error GoTo 0
    MsgBox Int((Timer - t) * 1000) & " ms"
End Sub

Cliquez pour agrandir...

Private Sub EuroRon(ByRef Monnaie As String)
    Dim f As Worksheet
    Set f = Worksheets(ActiveSheet.Name)
    Dim Devise As Double
    Range("E1") = Monnaie
    Devise = Range("J2").Value
    Dim r, c As Range
    Set r = f.Range(f.Cells(6, 4), f.Cells(f.Cells(65536, 2).End(xlUp).Row, 16))
    On Error Resume Next
    For Each c In r
        If Not c.HasFormula = True And c.Value <> Empty Then
            [S]'c.Value = IIf(f.Range("E1").Value = "EURO", c.Value / Devise, c.Value * Devise)[/S]
           c.Value = IIf(f.Range("E1").Value = "EURO", c.Value * Devise, c.Value / Devise)
        End If
    Next c
    On Error GoTo 0
    MsgBox Int((Timer - t) * 1000) & " ms"
End Sub