[XL-2003] Moteur Do While

[korni184]

Hello,

Je voudrais transformer ce code en ajoutant un moteur (Do While) afin de pouvoir ajouter à côter de chaque cellule le montant formaté et la devise.

Vu que le nombre de ligne est variable, je voudrais tout simplement que le traitement s'arrête lorsqu'il y a plus de données.

C'est à dire :

A1 : 4500,USD
A2 : 25000,USD
A3 : plus de données

Donc logiquement en B1,C1 ET B2 ET C2 il doit me faire mon formatage. Et en A3, il arrête.

Pouvez-vous m'aider ?

Merci d'avance

Colonne A les montants+devises

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 1234567891011121314151617 Sub Macro1() 
' 
Sub Macro1() 
' 
' Macro1 Macro 
' Macro recorded 16/11/2011  
' 
' Keyboard Shortcut: Ctrl+a 
' 
 Dim Montant As String 
 Dim Devise As String 
'Suppression des espaces blancs 
 Columns("A:A").Select 
 Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ 
 SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
 ReplaceFormat:=False 
'Définition du montant 
 Montant = Replace(Mid(Range("A1"), 4, Len(Range("A1").Value) - 4), ",", ".") 
 
'Définition de la devise 
 Devise = Replace(Mid(Range("A1"), 1, Len(Range("A1").Value) - 6), ",", ".") 
 
'Ajout du montant dans la colonne B 
 Range("B1").Value = Val(Montant) 
 
'Ajout de la devise dans la colonne C 
 Range("C1").Value = Devise 
'Ajout des décimales colonne B 
 Range("B:B").Select 
 Selection.NumberFormat = "0.00" 
 
End Sub

[Daniel.C]

Bonjour,

En ajoutant une boucle :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 16/11/2011
'
' Keyboard Shortcut: Ctrl+a
'
 Dim Montant As String
 Dim Devise As String
'Suppression des espaces blancs
 Columns("A:A").Replace What:=" ", Replacement:="", LookAt:=xlPart, _
    SearchFormat:=False, ReplaceFormat:=False
'Définition du montant
 For Each c In Range([A1], Cells(Rows.Count, 1).End(xlUp))
     Montant = Replace(Mid(c.Value, 4, Len(c.Value) - 4), ",", ".")
 
    'Définition de la devise
     Devise = Replace(Mid(c.Value, 1, Len(c.Value) - 6), ",", ".")
 
    'Ajout du montant dans la colonne B
     c.Offset(, 1).Value = Val(Montant)
 
    'Ajout de la devise dans la colonne C
     c.Offset(, 1).Value = Devise
 Next c
'Ajout des décimales colonne B
 Range("B:B").NumberFormat = "0.00"
 
End Sub

[ZebreLoup]

En reprenant le code de ton autre sujet :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Macro1()
    Dim iRow As Integer
    Dim montant As Double
    Dim devise As String
    Dim texte As String
 
    iRow = 1
 
    While Cells(iRow, 1) <> ""
        texte = Cells(iRow, 1).Value
        montant = Replace(Right(texte, Len(texte) - 4), ",", ".")
        devise = Left(texte, 3)
 
        Cells(iRow, 2).Value = montant
        Cells(iRow, 2).NumberFormat = "0.00"
        Cells(iRow, 3).Value = devise
 
        iRow = iRow + 1
    Wend
End Sub

Tu verras par contre que j'ai pas mal simplifier les choses pour que ça fasse moins du code tout droit sorti de l'enregistreur de macro.
Et pour les futurs lecteurs, le replace ne sert que si le format numérique n'est pas le même dans l'extraction et dans excel, on pourra également avoir besoin de faire l'inverse si les données sont avec un . et Excel en notation française.