OVH Cloud OVH Cloud

Eliminer...seulement

19 réponses
Avatar
Denys
Bonjour =E0 tous,

Petit probl=E8me =E0 vous soumettre. Sur une feuille Excel, je=20
re=E7ois mensuellement des donn=E9es qui peuvent facilement=20
atteindre plus de 15,000 lignes.

En colonne C j'ai le nom des cies, en colonne D, le=20
montant des transactions. Je vous fais gr=E2ce des infos=20
contenues dans les autres colonnes.

Je dois =E9liminer toutes les lignes suaf celles appartenant=20
disons =E0 la cie ABC, GHI et les trois compagnies dont le=20
montant total des transactions est le plus =E9lev=E9.

Le probl=E8me que j'ai est de la fa=E7on dont se pr=E9sente ces=20
donn=E9es... En voici un aper=E7u:

B C

ABC $5.00=20
$5.10=20
$5.20=20
$5.30=20
$5.40=20
$5.50=20
DEF $12.32=20
$13.25=20
$14.18=20
$15.11=20
$16.04=20
$16.97=20
$17.90=20
$18.83=20
GHI $7.54=20
$7.91=20
$8.28=20
$8.65=20
$9.02=20
$9.39=20
$9.76=20
$10.13=20
JKLMN $1.67=20
$2.01=20
$2.35=20
$2.69=20
$3.03=20
$3.37=20
$3.71=20
$4.05=20
$4.39=20
PQR $3.23=20
$3.44=20
$3.65=20
$3.86=20
$4.07=20
$4.28=20
$4.49=20
$4.70=20
$4.91=20
$5.12=20
$5.33=20
$15.54=20
$15.75=20
$15.96=20
$16.17=20
$16.38=20
$16.59=20
$16.80=20
$17.01=20
$17.22=20
STU $4.33=20
$4.44=20
$4.55=20

Les noms de cie ne se r=E9p=E9tant pas dans la colonne B,=20
Comment faire pour dire =E0 Excel de faire le calcul dans C,=20
trouver les 3 qui ont le montant le plus =E9lev=E9, et ensuite=20
=E9liminer toutes les autres except=E9es ABC, GHI et les 3=20
plus performantes (sans tenir compte de la performance de=20
ABC et GHI...

Compliqu=E9 n'est-ce pas ????

Si vous avez une id=E9e, vous =EAtes les bienvenus...

Merci pour votre temps

Denys

9 réponses

1 2
Avatar
isabelle
et je continue à m'amuser ;-), voilà un poil plus court avec une
fonction donnée ici par AV,

Sub ee()
For Each c In Range("B2:B" & Range("C65536").End(xlUp).Row)
If c = Empty Then
Range(c.Address) = Ci
Else: Ci = c
End If
If c = "ABC" Or c = "GHI" Then Range("E" & c.Row) = 1
Next
For i = 2 To Range("C65536").End(xlUp).Row
plgC = Range("B2:B" & Range("C65536").End(xlUp).Row).Address
plgM = Range("C2:C" & Range("C65536").End(xlUp).Row).Address
Range("D" & i) = Evaluate("SUMPRODUCT((" & plgM & ")*(" & plgC & "=B" &
i & "))")
Next
Range("B:E").Sort Key1:=Range("E1"), Order1:=xlAscending,
Key2:=Range("D1") _
, Order2:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2:=xlSortNormal
zz = Range("D" & Range("E65536").End(xlUp).Row + 1 & ":D" & _
Range("C65536").End(xlUp).Row).Address
X = Evaluate("=LARGE(IF(MMULT((" & zz & "=TRANSPOSE(" & zz & _
"))*(ROW(" & zz & ")>=TRANSPOSE(ROW(" & zz & "))),ROW(" & _
zz & ")^0)=1," & zz & "),4)")
Rows(Application.Match(X, [d:d], 0) & ":" &
Range("C65536").End(xlUp).Row).Delete
End Sub

isabelle


Bonjour Isabelle,

T'as travaillé fort...WOW!!!

Starwing

Sub Macro6()
For Each c In Range("B2:B" & Range("C65536").End(xlUp).Row)
If c = Empty Then
Range(c.Address) = Ci
Else: Ci = c
End If
Next
For i = 2 To Range("C65536").End(xlUp).Row
plgC = Range("B2:B" & Range("C65536").End
(xlUp).Row).Address
plgM = Range("C2:C" & Range("C65536").End
(xlUp).Row).Address
If Range("B" & i) <> Range("B" & i - 1) Then _
Range("D" & i) = Evaluate("SUMPRODUCT((" & plgM & ")*(" &
plgC & "=B" &
i & "))")
Next
GV1 = Application.Large([D:D], 1)
GV2 = Application.Large([D:D], 2)
GV3 = Application.Large([D:D], 3)
Ci1 = Application.Index([B:B], Application.Match(GV1,
[D:D], 0))
Ci2 = Application.Index([B:B], Application.Match(GV2,
[D:D], 0))
Ci3 = Application.Index([B:B], Application.Match(GV3,
[D:D], 0))
x = 4
If Ci1 = "ABC" Or Ci1 = "GHI" Then
GV1 = Application.Large([D:D], x)
x = x + 1
End If
If Ci2 = "ABC" Or Ci2 = "GHI" Then
GV2 = Application.Large([D:D], x)
x = x + 1
End If
If Ci3 = "ABC" Or Ci3 = "GHI" Then
GV3 = Application.Large([D:D], x)
End If
Ci1 = Application.Index([B:B], Application.Match(GV1,
[D:D], 0))
Ci2 = Application.Index([B:B], Application.Match(GV2,
[D:D], 0))
Ci3 = Application.Index([B:B], Application.Match(GV3,
[D:D], 0))
For i = Range("C65536").End(xlUp).Row To 2 Step -1
Select Case Range("B" & i)
Case Ci1, Ci2, Ci3, "ABC", "GHI"
Case Else
Rows(i).Delete
End Select
Next
End Sub

isabelle


Avatar
Daniel.M
Salut Isabelle,

Voici une solution à UNE boucle qui ne fonctionne qui si les données sont
ordonnées tel que le mentionne Denys:

' Les cies à conserver peu importe leur total
' doivent être présentes dans une plage CIEEXCLURE
' (pour les données du problème: ce serait une plage de
' 2 cellules contenant ABC et GHI

Sub Macro7()
Dim C As Range, Total As Double
Dim PremCol As Long, PremLigne As Long, Ligne As Long

PremLigne = 2: PremCol = 6: Ligne = PremLigne

For Each C In Range("B2:B" & Range("B65536").End(xlUp).Row)
If IsNumeric(C) Then
Total = Total + C
Else
Cells(Ligne, PremCol) = C
If Ligne > PremLigne Then
Cells(Ligne - 1, PremCol + 1) = Total
End If
Total = C(1, 2)
Ligne = Ligne + 1
End If
Next C
Cells(Ligne - 1, PremCol + 1) = Total 'inscrit le dernier total

' C'est terminé! : il ne reste qu'à trier puis enlever les
' entrées excédentaires.
With Cells(PremLigne, PremCol + 2).Resize(Ligne - 1, 1) '3e col de l'output
.FormulaR1C1 = "=N(ISNUMBER(MATCH(RC[-2],CIEEXCLURE,0)))"
.Value = .Value
' on tri, avec clé1 la 3e col, clé2 la 2e col
Cells(PremLigne, PremCol).Resize(Ligne - 1, 3).Sort _
Key1:Îlls(PremLigne, PremCol + 2), Order1:=xlDescending, _
Key2:Îlls(PremLigne, PremCol + 1), Order2:=xlDescending
.ClearContents ' on détruit la 3e colonne de l'output
End With

' prendre les 5 premiers : i.e. 2 (de CIEEXCLURE) + 3 PROCHAINS
' donc éliminer les entrées en-dessous
With Cells(PremLigne + 5, PremCol)
Range(.Cells, .End(xlDown)(1, 2)).ClearContents
End With

End Sub

Daniel M.
Avatar
Denys
Bonjour Daniel, Isabelle, AV et Clément,

Je suis médusé !!!!! J'ai pourtant la verbe facile, mais
là!!!

Quelle façon géniale de commencer la fin de semaine. Je
vais certainement m'amuser à jouer avec tout cela.

Merci à tous....et bonne fin de semaine

Denys


-----Original Message-----
Salut Isabelle,

Voici une solution à UNE boucle qui ne fonctionne qui si
les données sont

ordonnées tel que le mentionne Denys:

' Les cies à conserver peu importe leur total
' doivent être présentes dans une plage CIEEXCLURE
' (pour les données du problème: ce serait une plage de
' 2 cellules contenant ABC et GHI

Sub Macro7()
Dim C As Range, Total As Double
Dim PremCol As Long, PremLigne As Long, Ligne As Long

PremLigne = 2: PremCol = 6: Ligne = PremLigne

For Each C In Range("B2:B" & Range("B65536").End
(xlUp).Row)

If IsNumeric(C) Then
Total = Total + C
Else
Cells(Ligne, PremCol) = C
If Ligne > PremLigne Then
Cells(Ligne - 1, PremCol + 1) = Total
End If
Total = C(1, 2)
Ligne = Ligne + 1
End If
Next C
Cells(Ligne - 1, PremCol + 1) = Total 'inscrit
le dernier total


' C'est terminé! : il ne reste qu'à trier puis
enlever les

' entrées excédentaires.
With Cells(PremLigne, PremCol + 2).Resize(Ligne - 1,
1) '3e col de l'output

.FormulaR1C1 = "=N(ISNUMBER(MATCH(RC[-
2],CIEEXCLURE,0)))"

.Value = .Value
' on tri, avec clé1 la 3e col, clé2 la 2e col
Cells(PremLigne, PremCol).Resize(Ligne - 1,
3).Sort _

Key1:Îlls(PremLigne, PremCol + 2),
Order1:=xlDescending, _

Key2:Îlls(PremLigne, PremCol + 1),
Order2:=xlDescending

.ClearContents ' on détruit la 3e colonne
de l'output

End With

' prendre les 5 premiers : i.e. 2 (de CIEEXCLURE) + 3
PROCHAINS

' donc éliminer les entrées en-dessous
With Cells(PremLigne + 5, PremCol)
Range(.Cells, .End(xlDown)(1, 2)).ClearContents
End With

End Sub

Daniel M.


.



Avatar
isabelle
Hello Daniel,

j'obtiens ça comme résultat
DEF 12.32
GHI 7.54
ABC 5
STU 4.33
PQR 3.23

je ne l'avais pas vu de cette façon, est ce bien les résultat voulu...
seul Denys pourra nous le dire ;-)
tourlou et bisou,
isabelle


Salut Isabelle,

Voici une solution à UNE boucle qui ne fonctionne qui si les données sont
ordonnées tel que le mentionne Denys:

' Les cies à conserver peu importe leur total
' doivent être présentes dans une plage CIEEXCLURE
' (pour les données du problème: ce serait une plage de
' 2 cellules contenant ABC et GHI

Sub Macro7()
Dim C As Range, Total As Double
Dim PremCol As Long, PremLigne As Long, Ligne As Long

PremLigne = 2: PremCol = 6: Ligne = PremLigne

For Each C In Range("B2:B" & Range("B65536").End(xlUp).Row)
If IsNumeric(C) Then
Total = Total + C
Else
Cells(Ligne, PremCol) = C
If Ligne > PremLigne Then
Cells(Ligne - 1, PremCol + 1) = Total
End If
Total = C(1, 2)
Ligne = Ligne + 1
End If
Next C
Cells(Ligne - 1, PremCol + 1) = Total 'inscrit le dernier total

' C'est terminé! : il ne reste qu'à trier puis enlever les
' entrées excédentaires.
With Cells(PremLigne, PremCol + 2).Resize(Ligne - 1, 1) '3e col de l'output
.FormulaR1C1 = "=N(ISNUMBER(MATCH(RC[-2],CIEEXCLURE,0)))"
.Value = .Value
' on tri, avec clé1 la 3e col, clé2 la 2e col
Cells(PremLigne, PremCol).Resize(Ligne - 1, 3).Sort _
Key1:Îlls(PremLigne, PremCol + 2), Order1:=xlDescending, _
Key2:Îlls(PremLigne, PremCol + 1), Order2:=xlDescending
.ClearContents ' on détruit la 3e colonne de l'output
End With

' prendre les 5 premiers : i.e. 2 (de CIEEXCLURE) + 3 PROCHAINS
' donc éliminer les entrées en-dessous
With Cells(PremLigne + 5, PremCol)
Range(.Cells, .End(xlDown)(1, 2)).ClearContents
End With

End Sub

Daniel M.


Avatar
Daniel.M
Salut Isabelle,

J'obtiens ceci:
GHI 70.68
ABC 31.5
PQR 194.5
DEF 124.6
JKLMN 27.27

J'ai défini une plage CIEEXCLURE, qui contient ABC et GHI.

En col B, j'ai le nom de la CIE (pour les premières entrées) ou un montant.
En col C, j'ai le montant (lorsqu'il y a un nom en col B).

Salutations,

Daniel M.

"isabelle" wrote in message
news:
Hello Daniel,

j'obtiens ça comme résultat
DEF 12.32
GHI 7.54
ABC 5
STU 4.33
PQR 3.23

je ne l'avais pas vu de cette façon, est ce bien les résultat voulu...
seul Denys pourra nous le dire ;-)
tourlou et bisou,
isabelle



Avatar
docm
Bonjour Denys.

Voici une autre méthode :

'Eliminer toutes les cies sauf les 3 plus performantes et
'celles se trouvant sur colonne A de la feuille "CieAConserver"
Sub test()
'Il faut 3 feuilles
FeuilleOrigine = "Feuil1" 'les données
PremiereligneDeDonnéesSurFeuilleOrigine = 2
CieAConserver = "Feuil4" 'Liste des compagnies dont il ne faut pas tenir
compte
CiesASupprimer = "feuil3" 'Feuille de travail temporaire


Sheets(CiesASupprimer).Select
Sheets(CiesASupprimer).Cells.ClearContents

For i = PremiereligneDeDonnéesSurFeuilleOrigine To
Sheets(FeuilleOrigine).Range("C65536").End(xlUp).Row

If Trim(Sheets(FeuilleOrigine).Cells(i, 2) <> "") Then
ligne = ligne + 1
Sheets(CiesASupprimer).Cells(ligne, 3) = i 'Premiere ligne pour cette
compagnie
Sheets(CiesASupprimer).Cells(ligne, 4) = i 'Derniere ligne pour cette
compagnie
Sheets(CiesASupprimer).Cells(ligne, 2) = Sheets(FeuilleOrigine).Cells(i,
2) ' Nom
Sheets(CiesASupprimer).Cells(ligne, 1) = Sheets(FeuilleOrigine).Cells(i,
3) * 1 'Montants
Else
Sheets(CiesASupprimer).Cells(ligne, 1) Sheets(CiesASupprimer).Cells(ligne, 1) + Sheets(FeuilleOrigine).Cells(i, 3)
* 1
Sheets(CiesASupprimer).Cells(ligne, 4) = i 'Derniere ligne pour cette
compagnie
End If
Next
'Mettre les plus performantes en début de liste
bascCeASupprimer = Sheets(CiesASupprimer).Range("A65536").End(xlUp).Row
R = "A1:D" & bascCeASupprimer
Sheets(CiesASupprimer).Range(R).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

'supprimer de la liste les cies a conserver
basAConserver = Sheets(CieAConserver).Range("A65536").End(xlUp).Row
For i = 1 To basAConserver
nomagarder = Sheets(CieAConserver).Cells(i, 1)
For j = 1 To bascCeASupprimer
If Sheets(CiesASupprimer).Cells(j, 2) = nomagarder Then
Rows(j & ":" & j).Select
Selection.Delete Shift:=xlUp
Exit For
End If
Next
Next
'Enlever les 3 premieres cies de la liste
basCiesASupprimer = Sheets(CiesASupprimer).Range("A65536").End(xlUp).Row
For j = 3 To 1 Step -1
Rows(j & ":" & j).Select
Selection.Delete Shift:=xlUp
Next

'Classer selon l'ordre inverse d'apparition sur la feuille principale
basCiesASupprimer = Sheets(CiesASupprimer).Range("A65536").End(xlUp).Row

R = "A1:D" & basCiesASupprimer
Sheets(CiesASupprimer).Range(R).Select
Selection.Sort Key1:=Range("C1"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

Sheets(FeuilleOrigine).Select
'Les données de ces compagnies sont à supprimer
For i = 1 To basCiesASupprimer
If Sheets(CiesASupprimer).Cells(i, 2) <> "" Then
derniereligne = Sheets(CiesASupprimer).Cells(i, 4)
premiereligne = Sheets(CiesASupprimer).Cells(i, 3)
For j = derniereligne To premiereligne Step -1
Rows(j & ":" & j).Select
Selection.Delete Shift:=xlUp
Next
End If
Next

End Sub

"Denys" wrote in message
news:d17001c439b3$6a6d8c70$
Bonjour à tous,

Petit problème à vous soumettre. Sur une feuille Excel, je
reçois mensuellement des données qui peuvent facilement
atteindre plus de 15,000 lignes.

En colonne C j'ai le nom des cies, en colonne D, le
montant des transactions. Je vous fais grâce des infos
contenues dans les autres colonnes.

Je dois éliminer toutes les lignes suaf celles appartenant
disons à la cie ABC, GHI et les trois compagnies dont le
montant total des transactions est le plus élevé.

Le problème que j'ai est de la façon dont se présente ces
données... En voici un aperçu:

B C

ABC $5.00
$5.10
$5.20
$5.30
$5.40
$5.50
DEF $12.32
$13.25
$14.18
$15.11
$16.04
$16.97
$17.90
$18.83
GHI $7.54
$7.91
$8.28
$8.65
$9.02
$9.39
$9.76
$10.13
JKLMN $1.67
$2.01
$2.35
$2.69
$3.03
$3.37
$3.71
$4.05
$4.39
PQR $3.23
$3.44
$3.65
$3.86
$4.07
$4.28
$4.49
$4.70
$4.91
$5.12
$5.33
$15.54
$15.75
$15.96
$16.17
$16.38
$16.59
$16.80
$17.01
$17.22
STU $4.33
$4.44
$4.55

Les noms de cie ne se répétant pas dans la colonne B,
Comment faire pour dire à Excel de faire le calcul dans C,
trouver les 3 qui ont le montant le plus élevé, et ensuite
éliminer toutes les autres exceptées ABC, GHI et les 3
plus performantes (sans tenir compte de la performance de
ABC et GHI...

Compliqué n'est-ce pas ????

Si vous avez une idée, vous êtes les bienvenus...

Merci pour votre temps

Denys
Avatar
Jacquouille
Bonsoir Isabeau
Le tourlou mentionné, c'est le diminutif de turlute ?
Jacques, bien peiné de ne pouvoir être à Saulieu.
--
Jacquouille conseille : http://www.excelabo.net


"isabelle" a écrit dans le message news:

Hello Daniel,

tourlou et bisou,
isabelle


Avatar
Clément Marcotte
Bonjour,

Le tourlou mentionné, c'est le diminutif de turlute ?


Pas à ma connaissance. C'est pour au-revoir...

Avatar
Jacquouille
Merci bien, Clément.
C' est que le François de là-bas n'est pas toujours le même.....
Bonne fin de WE

--
Jacquouille conseille : http://www.excelabo.net


"Clément Marcotte" a écrit dans le message
news:
Bonjour,

Le tourlou mentionné, c'est le diminutif de turlute ?


Pas à ma connaissance. C'est pour au-revoir...






1 2