Supp lignes si caractère d'1 plage <> A ou B

RoadRunner

XLDnaute Nouveau
Bonjour à tous

je voudrai améliorer mon 'ensemble de macros'

dans ceci :

Sub Transformation_HHMMSS()
Dim Cell As Range
Dim TmpMM As String
Dim TmpSS As String
Dim Container As Variant
Dim WS As Worksheet

For Each WS In ActiveWorkbook.Worksheets
With WS
For Each Cell In Union(.Range('B4:B300'), .Range('C4:C300'))
If InStr(1, Cell, 'mn', 1) <> 0 Then
On Error Resume Next
Container = Split(Cell, 'mn')
TmpMM = Val(Container(0))
TmpSS = Val(Container(1))
Cell = '00:' & Format(TmpMM, '00') & ':' & Format(TmpSS, '00')
End If
Next Cell

With .Range('B400')
.Formula = '=AVERAGE(B4:B300)'
.NumberFormat = 'hh:mms'
End With
With .Range('C400')
.Formula = '=AVERAGE(C4:C300)'
.NumberFormat = 'hh:mms'
End With

End With
Next WS
End Sub

EXPLICATION : dans mes feuilles j'ai une colonne D qui contient des lettres : soit A ou B ou C ou D
Ces lettres sont dans une plage D4:D300

Je voudrai, juste avant le calcul des moyennes, que toutes les lignes de cette plage qui n'ont pas soit 'A' soit 'B' en colonne D soient supprimées.

puis que les formules de moyennes suivantes changent :
(il y en a 2 ici mais ils m'en faut 4 comme citées plus bas)

With .Range('B400')
.Formula = '=AVERAGE(B4:B88)'
.NumberFormat = 'hh:mms'
End With
With .Range('C400')
.Formula = '=AVERAGE(C4:C88)'
.NumberFormat = 'hh:mms'
End With

1/ pour qu'en cellule B400 je n'ai la moyenne que des cellules de la colonne B qui ont en regard dans la colonne D la lettre 'B'
2/ pour qu'en cellule C400 je n'ai la moyenne que des cellules de la colonne C qui ont en regard dans la colonne D la lettre 'B'
3/ pour qu'en cellule B401 je n'ai la moyenne que des cellules de la colonne B qui ont en regard dans la colonne D la lettre 'A'
4/ pour qu'en cellule B401 je n'ai la moyenne que des cellules de la colonne B qui ont en regard dans la colonne D la lettre 'A'

tout ça au format 'hh:mms' comme d'hab

c'est tout pour le moment !

j'imagine qu'il faut créer une variable qui va de 4 à 300
puis faire une boucle pour vérifier la présence des lettres 'A' et 'B' sinon effacer la ligne
puis trouver toutes les valeurs de la colonne B qui ont la lettre 'B' en colonne D pour en calculer la moyenne à mettre en cellule B400
et recommencer pour la colonne C avec toujours la lettre 'B' moyenne à mettre en cellule C400
et recommencer pour la colonne B et C mais lettre 'A' moyennes à mettre en cellule B401 et C401 respectivement

Peut paraitre simple !
enfin pour moi ;-)

mais mettre ça en VBA c'est autre chose !

Alors la je demande de l'aide car je n'y arriverai jamais seul !

à bientot
 

2passage

XLDnaute Impliqué
Bonjour,

juste 2 conseils : d'une part, sur la forme... essaye d'utiliser les balises code, du gras, de l'italique, des couleurs... enfin, je ne sais pas quoi, mais essaye de faire que ton message soit moins (pardon ! :eek: )rébarbatif... j'ai failli ne pas le lire...

D'autre part, pour la suppression, le coup de 'la variable qui va de 4 à 300 puis supprimer la ligne', attention de ne pas sauter des lignes. Exemple : si la ligne 3 est supprimée, la ligne 4 devient la ligne 3 donc ta variable ne doit plus aller que jusque 299 et tu dois reboucler sur 3 pour tester la ligne 3-qui-fut-4... je préfère scanner le range , et construire une selection que je supprime a la fin

A+
 

RoadRunner

XLDnaute Nouveau
Bonjour 2passage,

Je suis bien d'accord avec toi... mais je ne maitrise pas du tout...
mais voici ce que j'ai fait en rouge à défaut de trouver mieux !

Sub Transformation_HHMMSS()
Dim Cell As Range
Dim TmpMM As String
Dim TmpSS As String
Dim Container As Variant
Dim WS As Worksheet
Dim lig As Variant

For Each WS In ActiveWorkbook.Worksheets
With WS
WS.Activate
For lig = 4 To 300
If Cells(lig, 4) = 'C' Then Cells(lig, 4).EntireRow.Clear
If Cells(lig, 4) = 'D' Then Cells(lig, 4).EntireRow.Clear
If Cells(lig, 4) = '' Then Cells(lig, 4).EntireRow.Clear
Next lig


For Each Cell In Union(.Range('B4:B300'), .Range('C4:C300'))
If InStr(1, Cell, 'mn', 1) <> 0 Then
On Error Resume Next
Container = Split(Cell, 'mn')
TmpMM = Val(Container(0))
TmpSS = Val(Container(1))
Cell = '00:' & Format(TmpMM, '00') & ':' & Format(TmpSS, '00')
End If
Next Cell

With .Range('B400')
.Formula = '=AVERAGE(B4:B299)'
.NumberFormat = 'hh:mm:ss'
End With
With .Range('C400')
.Formula = '=AVERAGE(C4:C299)'
.NumberFormat = 'hh:mm:ss'
End With


End With
Next WS
End Sub

Voila ça fonctionne très bien à défaut de trouver mieux !

merci à tous...

Message édité par: RoadRunner, à: 18/08/2005 17:40
 

Statistiques des forums

Discussions
312 928
Messages
2 093 701
Membres
105 789
dernier inscrit
dulcioso