Pas assez de ressource pour faire tourner le script

Résolu
arthrax Messages postés 35 Date d'inscription mardi 20 septembre 2005 Statut Membre Dernière intervention 31 décembre 2023 - 15 déc. 2006 à 16:12
arthrax Messages postés 35 Date d'inscription mardi 20 septembre 2005 Statut Membre Dernière intervention 31 décembre 2023 - 18 déc. 2006 à 11:52
Bonjour,

J'ai fait un script VBA Excel (avec l'aide de plusieurs personnes du forum que je remerci encore )
Ce script parcourt une liste de nom d'AS400 sur la feuille "NomAS400" et pour chaque AS400, il ya un onglet avec pas mal de donnée.
Dans un premier temps je fais un tri pour trouver le dernier mois puis un autre pour l'année.
Puis j'active un filtre automatique en fonction du dernier mois et de la dernière année.
Je copi les données ainsi triées que je colle ensuite dans une aute cellule.
J'ai testé le programme pour une valeur et tout se passe bien.

Mais là avec environ 30 itérations, ça plante à la 16 itération avec le message d'erreur critique :
Excel ne peut pas terminer cette tâche avec les ressources disponibles. Sélectionnez moins de données ou fermez des applications.
Et erreur 1004 sur la partie en rouge dans le code en bas.

Mon processeur tourne à 100 %, ce qui est normal et il me reste 200 Mo de mémoire ram.
J'ai essayer de découper la liste en plusieurs parties que j'ai lancé séparément mais ça plante quand même.
J'ai P4 1.7Ghz, 512 de ram et je suis sous Excel 2003.

Est il possible d'optimisé mon script ou si vous avez d'autres idées ?
Ou dois je demander un pc plus puissant lol ?

Merci d'avance
Arthrax

Cas similaire :
http://www.vbfrance.com/infomsg_PROBLEME-RESSOURCES-DISPONIBLES-EXCEL-LORS-CONVERSION-PDF_839195.aspx

Sub txocc()

Dim CelluleCourante As Range
Dim CelluleSuivante As Range
Dim DernierMois As Range
Dim DerniereAnnee As Range
Sheets("NomAS400").Select   ' Sélection de la feuille contenant les noms
Set NomAS400 = Range("A2:A35")   'Liste des noms
For Each Valeur In NomAS400
             Sheets("" & Valeur).Select 'Sélection de la feuille
            'Tri pour trouver le dernier mois
            Set CelluleCourante = ActiveSheet.Range("BO4") 'BO4=dernier mois (déjà trier)
            Set DernierMois = CelluleCourante
            Do While Not IsEmpty(CelluleCourante) = True 'arret de la boucle si cellule vide
                Set CelluleSuivante = CelluleCourante.Offset(1, 0) 'descendre d'une ligne
                If CelluleSuivante.Value > CelluleCourante.Value Then
                    Set DernierMois = CelluleSuivante
                End If
                Set CelluleCourante = CelluleSuivante 'passage à la ligne suivante
            Loop
            'Tri pour trouver la dernière année
            Set CelluleCourante = ActiveSheet.Range("BN4") 'BN4=dernière année (déjà trier)
            Set DerniereAnnee = CelluleCourante
            Do While Not IsEmpty(CelluleCourante) = True
                Set CelluleSuivante = CelluleCourante.Offset(1, 0)
                If CelluleSuivante.Value > CelluleCourante.Value Then
                    Set DerniereAnnee = CelluleSuivante
                End If
                Set CelluleCourante = CelluleSuivante
            Loop
            Range("BL3").Select 'selection de la ligne où appliquer le filtre
            Selection.AutoFilter 'activer le filtre auto
            Selection.AutoFilter Field:=12, Criteria1:=DerniereAnnee 'critere du filtre
            Selection.AutoFilter Field:=13, Criteria1:=DernierMois
            Range("BD:BD,BF:BI,BK:BK").Select 'sélection des données à mettre dans le tableau
            Range("BK1").Activate         
            Selection.Copy
            Range("BV5").PasteSpecial xlPasteValues 'cellule où mettre la copie
            Selection.AutoFilter 'désactiver le filtre auto
Next
End Sub

2 réponses

cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
15 déc. 2006 à 23:40
Je ne comprend pas vraiment pourquoi tu boucles ainsi avec un tas de SET, mais bon, si ça fonctionne, c'est l'important.
Le problème provient entre autres du fait que tu sélectionnes 3 séries de colonnes et que tu essaies de coller dans une cellule qui n'est pas à la ligne 1 (BV5)

Même si tu essaies manuellement, ça ne passera pas. Si tu sélectionnes une colonne (65536 lignes = le maximum), tu ne peux coller autrement qu'en ligne 1 sinon il manque d'espace.

MPi
3
arthrax Messages postés 35 Date d'inscription mardi 20 septembre 2005 Statut Membre Dernière intervention 31 décembre 2023
18 déc. 2006 à 11:52
Bien joué , c'était la cause de mon problème de manque de ressource !!!

En gros comme tu l'as dit je sélectionnais toute la colonne soit 65536 lignes. Pour une colonne ça passe mais pour
 (3 séries de colonne + 33 itérations) * 65536 lignes à trier = beaucoup de calcul et pour la plupart qui servent à rien car c'est des lignes vides  !!

J'ai résolu mon problème en ne sélectionnant la colonne que jusqu'à la dernière cellule non vide gràce à :

                            Range("BD3", Range("BD3").End(xlDown)).Copy

Je te félicite encore car il fallait le voir

Arthrax

[.......................................................................................................................................]

Range("BL3").Select 'selection de la ligne où appliquer le filtre
            Selection.AutoFilter 'activer le filtre auto
            Selection.AutoFilter Field:=12, Criteria1:=DerniereAnnee 'critere du filtre
            Selection.AutoFilter Field:=13, Criteria1:=DernierMois
            Range("BD3", Range("BD3").End(xlDown)).Copy
            Range("BU3").PasteSpecial xlPasteValues
            Range("BF3", Range("BF3").End(xlDown)).Copy
            Range("BV3").PasteSpecial xlPasteValues
            Range("BG3", Range("BG3").End(xlDown)).Copy
            Range("BW3").PasteSpecial xlPasteValues
            Range("BH3", Range("BH3").End(xlDown)).Copy
            Range("BX3").PasteSpecial xlPasteValues
            Range("BI3", Range("BI3").End(xlDown)).Copy
            Range("BY3").PasteSpecial xlPasteValues
            Range("BK3", Range("BK3").End(xlDown)).Copy
            Range("BZ3").PasteSpecial xlPasteValues
            Selection.AutoFilter 'désactiver le filtre auto
0
Rejoignez-nous