Extraction conditionnelle un peu compliquée
- Messages
- 9'246
- Excel
- Vista Office 2007FR
- Inscrit
- 08/12/2007
- Emploi
- retraité Sce.Méthodes
re,
essaye de rester sur le forum ce soir (pour nous), on va régler le problème,
- Tu as ce message en collant les données ou en changeant la quantité ?
Je regarde, combien tu as de lignes, je vais faire une simulation avec le même nombre
de lignes.
Claude.
dubois a écrit :re,
- Tu as ce message en collant les données ou en changeant la quantité ?
Claude.
Je ne suis pas sûr de bien comprendre la question...
Je prends le fichier que vous m'envoyez ; à partir de mon fichier, je copie/colle mes données en A13. Je lance la macro en tapant 2 par exemple... et j'ai ce message d'erreur.
Au fait : c'est quoi les colonnes U et V ("Faux" et "Faux" à droite ?)
- Messages
- 9'246
- Excel
- Vista Office 2007FR
- Inscrit
- 08/12/2007
- Emploi
- retraité Sce.Méthodes
re,
avec 50000 lignes,
En supprimant le Goto FIN, on voit où se passe l'erreur, (je l'ai encadré au crayon)
il nous faudrait l'aide de Dan, je lui envoie un MP, s'il veux bien regarder cette ligne.
de mon coté je cherche aussi.
à+.....Claude.
édit: ce que tu vois (Vrai ou Faux) c'est les critères de filtre.
Ah ! Je me disais aussi que cette ligne ne me revenait pas !
Re
Bonsoir Claude,
j'ai trouvé ceci :
"Pour contourner ce problème si votre macro VBA copie et colle une plage de 2 516 lignes ou plus, modifiez le code de la macro pour s'exécuter en boucle pour copier et coller des plages de données plus réduites jusqu'à ce que toute la plage souhaitée soit copiée et collée."
Ca aide ?
Nad
- Messages
- 9'246
- Excel
- Vista Office 2007FR
- Inscrit
- 08/12/2007
- Emploi
- retraité Sce.Méthodes
re,
Nad,
Oui, çà confirme la solution que j' envisageait en dernier recours,
là, je décompose le traitement pour voir, je filtre seulement le MOD sans formule sur une
2ème feuille, mais çà mouline..
De ton coté, essaye d'ajouter des lignes progressivement jusqu'à ce que çà coince,
de sorte qu'après on pourra boucler avec ce multiple de lignes.
on sait déjà que 12500 c'est bon.
à suivre...Claude.
- Messages
- 9'246
- Excel
- Vista Office 2007FR
- Inscrit
- 08/12/2007
- Emploi
- retraité Sce.Méthodes
re,
Anthony, combien de lignes maxi peux-tu avoir sur ton fichier ?
Confiance et patience, on s'occupe de ton cas !
Claude
Heu...
Pour l'instant, on en a donc 220 000...
J'imagine qu'avec cette technologie des colliers GPS, et à présent qu'Excel 2007 peut accepter plus de lignes, mes collègues du labo vont en abuser...
Maintenant, ce projet est l'un des plus gros projets sur le sujet, et je doute que beaucoup de monde ait autant de fric à dépenser sur autant de colliers GPS, donc je ne pense pas qu'on excèdera les 400 000 lignes de si tôt !
Merci de "t'occuper de mon cas" !
Au plaisir !
- Messages
- 9'246
- Excel
- Vista Office 2007FR
- Inscrit
- 08/12/2007
- Emploi
- retraité Sce.Méthodes
re,
je me pose une question, pourquoi attendre d'avoir 400 000 lignes,
tu ne peux pas imaginer des relevés sur un an seulement et ouvrir un autre fichier pour
l'année suivante,
On saurait faire une synthèse des différents fichiers,
Là, j'ai les yeux qui se croisent, je vais dodo
à demain
Claude.
Oui, tu as tout à fait raison, et c'est mon point de vue...
Quand mes collègues se plaignent des soucis qu'ils ont avec de si gros fichiers, je leur demande comment on faisait il y a 4 ans, quand Excel ne gérait pas plus de 65 000 lignes et que nos ordis ne connaissaient pas encore les processeurs à 4 coeurs !
Malheureusement, je ne fais que récupérer les fichiers qu'ils me donnent !
Mais d'un autre côté, je peux leur dire aussi que si leurs fichiers excèdent 100 000 lignes, je ne pourrai pas le traiter et qu'ils aillent se faire voir ailleurs ! lol !
- Messages
- 9'246
- Excel
- Vista Office 2007FR
- Inscrit
- 08/12/2007
- Emploi
- retraité Sce.Méthodes
Bonsoir à tous,
Anthony, 2 nouvelles macros testées sur 200284 lignes, le temps de traitement ne
dépasse pas 34 secondes dans le pire des cas (2)
Sub ExtraitAvecFormules()
''Claude le 17 juin 09
Dim Lg As Long, Nb&, Nb1&, Nb2&, i As Byte
Dim Cel As Range
Dim Plg As Variant, X As Variant, y As Variant, Cycle As Variant
X = Time
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
On Error Resume Next
ActiveSheet.ShowAllData 'libère le filtre
On Error GoTo 0
Lg = Range("A2").End(xlDown).Row
Range("s13:s" & Lg).ClearContents
Range("a2:q" & Lg).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("u1:u2"), Unique:=False
'On Error GoTo FIN
Cycle = Lg / 10000 'cycle boucle
Nb = Lg / Cycle
Set Plg = Range(Range("s" & 3), Range("s" & Nb)).SpecialCells(xlCellTypeVisible)
Plg.FormulaR1C1 = "=IF(SUMPRODUCT((R[1]C[-17]:R[10]C[-17]=RC[-17])*(R[1]C[-11]:R[10]C[-11]+R[1]C[-7]:R[10]C[-7]=RC[-11]+RC[-7]+TIME(R1C13,0,0))+(SUMPRODUCT((R[-10]C[-17]:R[-1]C[-17]=RC[-17])*(R[-10]C[-11]:R[-1]C[-11]+R[-10]C[-7]:R[-1]C[-7]=RC[-11]+RC[-7]-TIME(R1C13,0,0)))))>0, 1, 0)"
For i = 2 To Cycle
Nb1 = WorksheetFunction.Max(Nb, Nb2)
Nb2 = Nb1 + Nb
Set Plg = Range(Range("s" & Nb1), Range("s" & Nb2)).SpecialCells(xlCellTypeVisible)
Plg.FormulaR1C1 = "=IF(SUMPRODUCT((R[1]C[-17]:R[10]C[-17]=RC[-17])*(R[1]C[-11]:R[10]C[-11]+R[1]C[-7]:R[10]C[-7]=RC[-11]+RC[-7]+TIME(R1C13,0,0))+(SUMPRODUCT((R[-10]C[-17]:R[-1]C[-17]=RC[-17])*(R[-10]C[-11]:R[-1]C[-11]+R[-10]C[-7]:R[-1]C[-7]=RC[-11]+RC[-7]-TIME(R1C13,0,0)))))>0, 1, 0)"
For Each Cel In [Plg]
Cel = Cel.Value 'écrit en dur
Next Cel
Next i
'************** 2ème filtre ne sort que les 1 *********
Range("a2:s" & Lg).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("v1:v2"), Unique:=False
Range("s:s").Clear
Application.Goto Range("a3"), Scroll:=True
Range("m1").Activate
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
y = Time
MsgBox ("temps macro = " & Format(y - X, "hh:mm:ss"))
Exit Sub
FIN: MsgBox ("erreur !ou pas de données")
Application.EnableEvents = True
End Sub
Et macro de Dan qui à bien voulu nous aider
Sub ExtraitAvecFormulesDan()
Dim Lg As Long, i As Long
Dim X As Variant, y As Variant
X = Time
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
On Error Resume Next
ActiveSheet.ShowAllData 'libère le filtre
On Error GoTo 0
Lg = Range("A2").End(xlDown).Row
Range("s13:s" & Lg).ClearContents
Range("a2:q" & Lg).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("u1:u2"), Unique:=False
On Error GoTo FIN
For i = 3 To Lg
If ActiveSheet.Rows(i).Hidden = False Then
With Range("S" & i)
.FormulaR1C1 = "=IF(SUMPRODUCT((R[1]C[-17]:R[10]C[-17]=RC[-17])*(R[1]C[-11]:R[10]C[-11]+R[1]C[-7]:R[10]C[-7]=RC[-11]+RC[-7]+TIME(R1C13,0,0))+(SUMPRODUCT((R[-10]C[-17]:R[-1]C[-17]=RC[-17])*(R[-10]C[-11]:R[-1]C[-11]+R[-10]C[-7]:R[-1]C[-7]=RC[-11]+RC[-7]-TIME(R1C13,0,0)))))>0, 1, 0)"
Range("S" & i) = Range("S" & i)
End With
End If
Next
'************** 2ème filtre ne sort que les 1 *********
Range("a2:s" & Lg).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("v1:v2"), Unique:=False
Range("s:s").Clear
Application.Goto Range("a3"), Scroll:=True
Range("m1").Activate
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
y = Time
MsgBox ("temps macro = " & Format(y - X, "hh:mm:ss"))
Exit Sub
FIN: MsgBox ("erreur !ou pas de données")
Application.EnableEvents = True
End Sub
tu choisiras, mais n'oublie pas de changer le Private Sub
pour l'une ou l'autre,
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Application.Intersect(Target, Range("m1")) Is Nothing Then
Call ExtraitAvecFormules
'Call ExtraitAvecFormulesDan
End If
End Sub
Tiens-nous au courant
Amicalement
Claude.
- Messages
- 9'246
- Excel
- Vista Office 2007FR
- Inscrit
- 08/12/2007
- Emploi
- retraité Sce.Méthodes
Bonjour à tous,
Macro modifiée, 22 secondes maxi
Sub ExtraitAvecFormules()
''Claude le 18 juin 09
Dim Lg As Long, Nb&, Nb1&, Nb2&, i As Byte
Dim Cel As Range
Dim Plg As Variant, X As Variant, Y As Variant, Cycle As Variant
X = Time
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
On Error Resume Next
ActiveSheet.ShowAllData 'libère le filtre
On Error GoTo 0
Lg = Range("A2").End(xlDown).Row
Range("s13:s" & Lg).ClearContents
Range("a2:q" & Lg).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("u1:u2"), Unique:=False
'On Error GoTo FIN
'Cycle = Lg / 10000 'cycle boucle
Cycle = WorksheetFunction.Ceiling(Lg / 10000, 1)
Nb = Lg / Cycle
For i = 1 To Cycle
Nb1 = WorksheetFunction.Max(3, Nb2)
Nb2 = Nb1 + Nb
Set Plg = Range(Range("s" & Nb1), Range("s" & Nb2)).SpecialCells(xlCellTypeVisible)
Plg.FormulaR1C1 = "=IF(SUMPRODUCT((R[1]C[-17]:R[10]C[-17]=RC[-17])*(R[1]C[-11]:R[10]C[-11]+R[1]C[-7]:R[10]C[-7]=RC[-11]+RC[-7]+TIME(R1C13,0,0))+(SUMPRODUCT((R[-10]C[-17]:R[-1]C[-17]=RC[-17])*(R[-10]C[-11]:R[-1]C[-11]+R[-10]C[-7]:R[-1]C[-7]=RC[-11]+RC[-7]-TIME(R1C13,0,0)))))>0, 1, 0)"
For Each Cel In [Plg]
Cel = Cel.Value 'écrit en dur
Next Cel
Next i
'************** 2ème filtre ne sort que les 1 *********
Range("a2:s" & Lg).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("v1:v2"), Unique:=False
Range("s:s").Clear
Application.Goto Range("a3"), Scroll:=True
Range("m1").Activate
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Y = Time
MsgBox ("temps macro = " & Format(Y - X, "hh:mm:ss"))
Exit Sub
FIN: MsgBox ("erreur !ou pas de données")
Application.EnableEvents = True
End Sub
à titre indicatif, et sans esprit de compétition :
Mais Dan n'a peut-être pas dit son dernier mot !
Amicalement
Claude.
Lol !
Vous êtes des bons !
Je suis sur le terrain, donc je ne peux pas trop m'occuper d'essayer la macro pour l'instant - mais j'essaye de voir ça ce week-end !