Convertir formats de cellule Excel en VBA

Bonjour à tous,

Je souhaiterai convertir 5 formats de colonne en fonction de mon projet lorsque j'ouvre mon tableau.

Actuellement :

- la colonne A correspond à des MILES PER GALON et il faut la convertir en L/100km donc multiplier la valeur actuelle par 235 (1MPG=235l/100km)

- la colonne B PAS DE MODIFICATION

- la colonne C correspond à des CUBIC INCH et il faut la convertir en CM3 donc multiplier la valeur actuelle par 16,38 (1cubic inch=16,38cm3)

- la colonne D PAS DE MODIFICATION

- la colonne E PAS DE MODIFICATION

- la colonne F correspond à l'accélération en MPH/S et il faut la convertir en M/S² donc multiplier la valeur actuelle par 0,447 (1MPH/S=0,447M/S²)

- la colonne G correspond aux années (EX:70.) et il faut la convertir en année (EX: 1970) donc faire + 1900 à la valeur actuelle

- la colonne H correspond aux origines géographique (1,2,3) et il faudrait les convertir en vrai pays (1=US, 2=UE, 3=ASIE)

J'ai fait plusieurs test sur EXCEL mais vu que dans la base de données, les cellules sont des réels avec des points à la fin (EX: colonne A (18.0)) je n'ai pas su convertir en entier. De plus je souhaiterai les réaliser sous VBA pour que la conversion se fasse directement lorsqu'on ouvre le tableau ou d'un RUN.

Les NA en rouge ne doivent pas être supprimés

Je vous laisse ci-joint mon projet

Merci de votre attention

Bonne journée

Cordialement

Aubin

Bonsoir,

une proposition de code :

Sub LouReeD()
    Dim LaPlage
    ' on récupère la plage tableau en tableau VBA pour aller plus vite
    LaPlage = Feuil1.Range("A1").CurrentRegion.Value
    ' gestion d'erreur pour prendre en compte les "NA" sans intérompre le code
    On Error Resume Next
    ' on boucle sur la colonne 1 = A
    For i = 2 To UBound(LaPlage, 1)
        ' on multiplie les valeurs
        LaPlage(i, 1) = Evaluate(LaPlage(i, 1)) * 235
    Next i
    ' colonne 3 = C
    For i = 2 To UBound(LaPlage, 1)
        ' on multiplie les valeurs
        LaPlage(i, 3) = Evaluate(LaPlage(i, 3)) * 16.38
    Next i
    ' colonne F
    For i = 2 To UBound(LaPlage, 1)
        ' on multiplie les valeurs
        LaPlage(i, 6) = Evaluate(LaPlage(i, 6)) * 0.447
    Next i
    ' colonne G
    For i = 2 To UBound(LaPlage, 1)
        ' on additionne les valeurs
        LaPlage(i, 7) = Evaluate(LaPlage(i, 7)) + 1900
    Next i
    ' colonne H
    For i = 2 To UBound(LaPlage, 1)
        ' on sélectionne les valeurs
        LaPlage(i, 8) = IIf(Evaluate(LaPlage(i, 8)) = 1, "US", IIf(Evaluate(LaPlage(i, 8)) = 2, "UE", "ASIE"))
    Next i
    ' on retranscrit le tableau en feuille 2
    Feuil2.Range("A1").Resize(UBound(LaPlage, 1), UBound(LaPlage, 2)) = LaPlage
End Sub

Le fichier avec le bouton "Allons y !" :

@ bientôt

LouReeD

Bonjour à tous,
Une autre proposition VBA.
Alt F8 et exécuter la procédure.
Cdlt.

Public Sub TransformData()
Dim lo As ListObject, tbl, I As Long

    Set lo = Range("Tableau_auto_mpg").ListObject
    tbl = lo.DataBodyRange.Value

    For I = LBound(tbl) To UBound(tbl)
        tbl(I, 1) = IIf(Val(tbl(I, 1)) = 0, tbl(I, 1), Val(tbl(I, 1)) * 235)
        tbl(I, 2) = IIf(Val(tbl(I, 2)) = 0, tbl(I, 2), Val(tbl(I, 2)))
        tbl(I, 3) = IIf(Val(tbl(I, 3)) = 0, tbl(I, 3), Val(tbl(I, 3)) * 16.38)
        tbl(I, 4) = IIf(Val(tbl(I, 4)) = 0, tbl(I, 4), Val(tbl(I, 4)))
        tbl(I, 5) = IIf(Val(tbl(I, 5)) = 0, tbl(I, 5), Val(tbl(I, 5)))
        tbl(I, 6) = IIf(Val(tbl(I, 6)) = 0, tbl(I, 6), Val(tbl(I, 6)) * 0.447)
        tbl(I, 7) = IIf(Val(tbl(I, 7)) = 0, tbl(I, 7), Val(tbl(I, 7)) + 1900)
        Select Case Val(tbl(I, 8))
            Case 1: tbl(I, 8) = "US"
            Case 2: tbl(I, 8) = "UE"
            Case 3: tbl(I, 8) = "ASIE"
            Case Else:
        End Select
    Next I

    lo.DataBodyRange.Cells(1).Resize(UBound(tbl), 8).Value = tbl

End Sub

Ben oui forcément !

Bonsoir Jean-Eric ! Ca faisait longtemps, non ?

Bonne soirée à vous .

@ bientôt

LouReeD

Bonsoir tout le monde,

Merci à tous pour vos codes

Mon tableau fonctionne parfaitement et je vous en remercie.

Bonne soirée

Cordialement

Aubin VIEAU

PS : je postulerai surement un autre problème avant la fin de la semaine (si vous pourriez jeter un petit coup d'œil ! )