Extraction conditionnelle un peu compliquée

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 ?)

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.

Capture2

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

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.

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 !

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 !

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.

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 :

macro2

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 !

Rechercher des sujets similaires à "extraction conditionnelle peu compliquee"