[XL-2003] Ajout d'un total [Résolu]

[korni184]

Bonjour,

Je voudrais ajouter à au moteur ci-dessous deux choses :

- Un saut de deux lignes lorsqu'il rencontre une différence entre les devices
- L'ajout d'un total sur la première ligne que le programme saute, en gras de préférence.

Voici le code actuel :

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
 
Sub Macro1()
'Keyboard shortcut :Ctrl+a
Dim Montant As String 
Dim Devise As String 
Dim Cpt 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émarrage du compteur 
 Cpt = 1 
'Positionnement de départ 
 Range("a1").Select 
 
'Démarrage de la boucle 
 Do While ActiveCell.Value <> "" 
 Montant = Replace(Mid(Range("A" & Cpt), 4, Len(Range("A" & Cpt).Value) - 4), ",", ".") 
 Devise = Mid(Range("A" & Cpt), 1, 3) 
 Range("B" & Cpt).Value = Val(Montant) 
 Range("C" & Cpt).Value = Devise 
 ActiveCell.Offset(1, 0).Select 
 Cpt = Cpt + 1 
 Loop

Les données dans la fiche excel s'affichent comme tel :

Colonne A
Ligne 1 : EUR25000
Ligne 2 : EUR35000
Ligne 3 : USD12000
Ligne 4 : GBP15000
Ligne 5 : GBP305,50

Résultat effecuté avec la macro du dessus :

Colonne A
Ligne 1 : EUR25000

Colonne b : Ligne 1 : 25000,00
Colonne c : Ligne 1 : EUR

Résultat attendu avec vos modifications

Séparation lorsqu'il détecte en colonne C une différence entre les devises.
Saut de deux lignes, en ajoutant une somme en gras.

Merci d'avance

Bien à vous

[mercatog]

Si tes devises ont toutes 3 lettres, ci-joint proposition directe (sans aucune boucle)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub SousTotal()
Dim LastLig As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    'Enlève l'éventuel sous total
    .Range("A:C").RemoveSubtotal
    'Ligne de dernière cellule remplie de colonne A
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    'Efface les colonnes B et C
    .Range("B1:C" & LastLig).Clear
    'Titre colonnes B et C
    .Range("B1:C1") = Array("Devise", "Montant")
    'Convertir données
    .Range("A2:A" & LastLig).TextToColumns Destination:=.Range("B2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(3, 1))
    'Tri données sur devise
    .Range("A1:C" & LastLig).Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlYes
    'sous Total
    .Range("A1:C" & LastLig).Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With
End Sub

[korni184]

D'accord,

Merci pour le code, j'ai tout de même la valeur en A1 qui saute. Et qui n'est pas repris dans la somme total.

Cependant pouvez-vous tout de même m'aider pour essayer de l'ajouter dans ma boucle ?

Merci d'avance

Bàv,

[mercatog]

J'avais supposé que la ligne 1 est celle des titres
Sinon

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub SousTotal()
Dim LastLig As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    'Enlève l'éventuel sous total
    .Range("A:C").RemoveSubtotal
    'Efface les colonnes B et C
    .Range("B:C").Clear
    'Convertir données
    .Range("A:A").TextToColumns Destination:=.Range("B1"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(3, 1))
    'Tri données sur devise
    .Range("A:C").Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlNo
    'sous Total
    Application.DisplayAlerts = False
    .Range("A:C").Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Application.DisplayAlerts = True
End With
End Sub

[korni184]

Merci pour votre code.

Une question relation avec ce même sujet :

Si logiquement je place ainsi :

Code :

1
2
3
4
range("a1").select
Do while activecell.offset(0,2) = activecell.offset(1,2)
 
activecell.offset(1,0).select

En gros, je suis bloqué à cette endroit...
Jusqu'à ce que la devise soit identique, je change de ligne, sinon je saute deux ligne et j'ajoute un total

Comment faire ?