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:
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...
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
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
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
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.
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
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.
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
.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.
.
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
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
.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.
.
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.
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
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
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
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
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
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:
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
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
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
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" <anonymous@discussions.microsoft.com> wrote in message
news:d17001c439b3$6a6d8c70$a601280a@phx.gbl...
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:
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...
'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
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
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:
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
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
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
NoSpam_j.thiernesse@skynet.be
"isabelle" <as.isabellevIE@videotron.ca> a écrit dans le message news:
40A554AA.6F58302F@videotron.ca...
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
Clément Marcotte
Bonjour,
Le tourlou mentionné, c'est le diminutif de turlute ?
Pas à ma connaissance. C'est pour au-revoir...
Bonjour,
Le tourlou mentionné, c'est le diminutif de turlute ?