Boucle do loop while qui ne fonctionne pas

Version imprimable

Bonjour à tous,

Je viens trouver une solution à mon problème :)
Voilà la problématique: le titre "PT email" correspond à une campagne.
Tout ce qui commence par une date est un titre demail
Pour chaque campagne, je dois calculer les moyennes de col1, col2 et col3 pour les couples, les familles et les amis. 3 groupes a chaque fois. A un nouveau titre de campagne qui commence par "PT" je recommence le calcul.
Le but est d'avoir la moyenne de la col1, col2 et col3 pour les couples, les Friends et Adults pour l'email 1.
Et de faire pareil pour l'email 2. D'où mon do loop while
Voici un exemple de donnees :

PT  email     1		col1	col2	col3
2015-03-04_Couples	21,5%	0,6%	2,7%
2015-03-04_Families	22,5%	1,1%	4,7%
2015-03-04_Friends	23,4%	0,5%	2,0%
2015-03-18_families	13,4%	1,2%	9,1%
2015-03-18_Adults	12,5%	1,6%	12,8%
2015-03-20_adults	17,7%	2,3%	12,9%
2015-03-20_families	16,2%	2,4%	14,9%
PT  email      2                                   
2015-03-04_Couples	21,5%	0,6%	2,7%
2015-03-04_Families	22,5%	1,1%	4,7%
2015-03-04_Friends	23,4%	0,5%	2,0%
2015-03-18_families	13,4%	1,2%	9,1%
2015-03-18_Adults	12,5%	1,6%	12,8%
2015-03-20_adults	17,7%	2,3%	12,9%
2015-03-20_families	16,2%	2,4%	14,9%

Voilà ma macro:

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
Dim i As Integer
Dim j As Integer
Dim lastcell As Integer
Dim lastcell2 As Integer
 
 
lastcell = Sheets(1).Cells(65000, 1).End(xlUp).Row
lastcell2 = Sheets(1).Cells(65000, 1).End(xlUp).Row
 
 
    For i = 1 To lastcell
        extraction = Left(Cells(i, 1), 2)
        'MsgBox extraction
        Cells(i, 1).Select
        For Each cell In Selection
            Cells(i, 1).Value = LCase(Cells(i, 1).Value)
        Next cell
    Next i
 
        Do
              For j = 1 To lastcell2
                If Cells(j, 1).Value Like "*couples" Or Cells(j, 1).Value Like "*families" Then
                    tot = tot + Cells(j, 2)
                    Count = Count + 1
                End If
                Next j
 
        Loop While extraction = "pt"

Merci si vous avez une idee

Salut, ça marche en faisant:

Code:

1
2
3
4
5
6
7
8
9
For i = 1 To lastcell
 extraction = Left(Cells(i, 1), 2)
 'MsgBox extraction
 Cells(i, 1).Select
 For Each cell In Selection
 Cells(i, 1).Value = LCase(Cells(i, 1).Value)
 Next cell
i = i + 1
 Next i

J'ai un doute si il le fait automatiquement

28/04/2015, 11h06
nahamed

merci pour ta réponse mais le probleme se situe sur la boucle do et pas avant.

Cest a dire que le programme me fait l'addition de tous les pourcentages des emails1 et 2.
Alors que je veux uniquement le total par email.

Ah ok, pas compris, maintenant oui...

Tu cherches à faire le total de chaque colonne par groupe
Sur ton tableur, tu peux faire une case fusionnée appelé email 1 ("A"); à coté tu mets les 2015_couples("B")... et les %("c"; "d" ...)

et tu peux t'inspirer du code suivant
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Set AireMesures = Range(Range("A" & I)), Range(derniereLigne) For Each email In AireMesures If email <> "" Then If email.MergeCells = True Then Set AireDesCellulesemail = email.MergeArea i= 0 For j = AireDesCellulesemail.Count To 1 Step -1 'tu selectionne la colonne % pour total Next j 'calcul du total Set AireDesCellulesemail = Nothing End If End If Next email Set AireMesures = Nothing
j'ai eu un problème similaire mais plus complexe, j'ai retirer des parties dont tu ne doit pas avoir besoin.
Sur ce, bonne chance,

gabi974