Activesheet.paste qui plante toujours à la 13e boucle
Bonjour
J'ai lu comme un fou sur activesheet.paste (qui se trouve à la fin de mon code) et je ne trouve pas la solution.
Pour faire fonctionner la macro, faites ctrl+q (patientez un bon 2 à 5 minutes avant que ça ne plante au 13e tour de la boucle).
J'ai le problème qu'il fait les boucles comme un pro, mais qu'il plante toujours à la 13e boucle et toujours sur la ligne "activesheet.paste" avec le message "impossible de modifier une partie de la matrice" alors qu'il a réalisé les 12 précédentes sans aucun souci...
et mon code est lent, quand il termine une boucle, toutes les nouvelles cases copiées (il y en a + de 4900) se recalculent (et j'ai besoin de ces résultats avant que la boucle ne continue)... Avec mon fichier d'origine (+ de 22 000 élèves), ça prend du temps, car on dirait qu'il recalcule toute la feuille à chaque fois plutôt que seulement les cases nouvellement copiées... Bref, mon vrai problème, c'est que ça plante à la 13e répétition... car j'ai un total de 998 classes à analyser dans ce seul fichier et j'en ai 4 autres pareils qui attendent...
J'ai essayé de vider le presse-papier (je me suis dit que c'était peut-être un trop plein) qui faisait qu'il plantait, mais sans succès...
Voici mon code :
Sub CalculQrelETfixe()
'Pour les déplacements
Dim ligneclasse As Integer
Dim ligneencours As Integer
Dim colducodeprofgroupe As Integer
Dim i As Integer
Dim m As Integer
Dim col As Integer
Dim ModeRecalcul As Long
Dim nbclass As Integer
Dim Cible As DataObject
'Qrel
Dim pqrel As Single
Dim dqrel As Single
Dim tqrel As Single
' pour le calcul des quartiles
Dim rep As Integer
Dim ligne As Integer
Dim notesource As Integer
Dim NotePourQuartile As Integer
'nombre de ligne dans cette classe
Dim nbeleve As Integer
'valeur des variables
colducodeprofgroupe = 100
nbclasse = 998
'endroit où lect0 est écrit, prise des valeurs des variable pour une classe a démarrage (hors de la boucle)
Cells(2, 101).Select
'**** début boucle calcul quartiles pour une classe ****
'endroit où lect0 est écrit, prise des valeurs des variable pour une classe
'Boucle niveau quartile pour 1 compétence
' ***** pour faire afficher un message *****
For cl = 1 To nbclasse
UserForm1.Label1.Caption = "Je suis en train de calculer la classe " & cl & " de " & nbclasse
UserForm1.Show 0
UserForm1.Repaint
nbeleve = ActiveCell.Offset(1, 1)
ligneclasse = ActiveCell.Offset(0, 1)
col = 108
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
'************ Boucle du calcul de plusieurs matières
For m = 1 To 36 '36 est le vrai chiffre
'La valeur de col est finalement celle de la colonne où se trouve la variable pour la notesource à comparer.
pqrel = ActiveCell.Offset(14, 6)
dqrel = ActiveCell.Offset(15, 6)
tqrel = ActiveCell.Offset(16, 6)
nbnotes = ActiveCell.Offset(2, 1)
notesource = Cells(1, col)
ligneencours = ligneclasse
ActiveCell.Offset(0, 7).Select
If nbnotes < 4 Then GoTo passe Else GoTo continue
continue:
'****** Boucle pour calculer les q relatifs et fixes
' *** Boucle pour le qrel
For i = 1 To nbeleve
NotePourQuartile = Cells(ligneencours, notesource)
' MsgBox NotePourQuartile
Select Case NotePourQuartile
Case Is = 0
rep = 8
Case Is >= pqrel
rep = 1
Case Is >= dqrel
rep = 2
Case Is >= tqrel
rep = 3
Case Else
rep = 4
End Select
ActiveCell.Value = rep
'*** Calcul pour les qartiles fixe
' Déplacement d'une case vers la droite
ActiveCell.Offset(, 1).Select
' Cacul pour le quartile fixe
Select Case NotePourQuartile
Case Is = 0
rep = 8
Case Is >= 86, 6
rep = 1
Case Is >= 73, 3
rep = 2
Case Is >= 67, 15
rep = 3
Case Is >= 67, 15
rep = 5
Case Is >= 60
rep = 6
Case Else
rep = 4
End Select
ActiveCell.Value = rep
ligneencours = ligneencours + 1
ActiveCell.Offset(1, -1).Select
Next
'*******************Fin de la boucle pour le calcul d'une compétence
'Retour en haut de la colonne
ActiveCell.Offset(-nbeleve).Select
passe:
ActiveCell.Offset(, 2).Select
col = col + 9
Next
' ************************** fin Boucle pour plusieurs matières
' Changement de classe
Cells(ligneclasse, 100).Select
Range(Cells(ligneclasse, 100), Cells(ligneclasse + 23, 424)).Copy
ActiveCell.Offset(nbeleve).Select
ActiveSheet.Paste
Range(Cells(ligneclasse + nbeleve, 100), Cells(ligneclasse + 16, 424)).Select
Calculate
Cells(ligneclasse + nbeleve, 101).Select
' Application.Wait Time + TimeSerial(0, 0, 10)
' Vider le presse papier
'Set Cible = New DataObject
'Cible.SetText ""
'Cible.PutInClipboard
'Set Cible = Nothing
Next
UserForm1.Hide
Application.Calculation = ModeRecalcul
End SubBon, le fichier a plus de 600ko à partir de mon site:
http://stephanecote.org/wp-content/uploads/2015/05/Primaire-2010-16-2-tronque.xlsm
Merci pour votre aide... COmment un code peut bien fonctionner et planter toujours à la même place, mais après avoir complété fonctionné plusieurs fois avant???
C'est un mystère.
merci
Bonjour,
As-tu entrepris de faire une copie de ton fichier ... et, dans cette copie, de supprimer 95% de tes données ....???
Cela te donnerait une base pour commencer à debugger ton code ...
bonjour,
Comment un code peut bien fonctionner et planter toujours à la même place, mais après avoir complété fonctionné plusieurs fois avant???
C'est simple : C'est parce que cette fois là il rencontre un problème qu'il n'a pas rencontré les autres fois !
Pour le débogage, ça va être compliqué par que ce code est une combinaison de codage flou dans un plat de nouilles...
Le code nouille c'est :
If nbnotes < 4 Then GoTo passe Else GoTo continue (à proscrire)
et le codage flou c'est les multiples ActiveCell.Select... ActiveCell.Offset : On ne sait jamais ou on en est...
Il faut supprimer tous ces select inutiles et remplacer par des adresses de cells "en dur" parce que là pour le débogage...
Et si en plus tu optais pour un style de référence normal ça serait le Grall. Là, ça donne pas envie de se pencher...
Un petit exemple simplifié qui met en évidence la notation en dur :
Dim iR%, iC%
...
'Cells(2, 101).Select
iR = 2: iC = 101
For cl = 1 To nbclasse
nbeleve = Cells(iR + 1, iC + 1) 'ActiveCell.Offset(1, 1)
ligneclasse = Cells(iR, iC + 1) 'ActiveCell.Offset(0, 1)
col = 108
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
For m = 1 To 36 '36 est le vrai chiffre
pqrel = Cells(iR + 14, iC + 6) 'ActiveCell.Offset(14, 6)
dqrel = Cells(iR + 15, iC + 6) 'ActiveCell.Offset(15, 6)
tqrel = Cells(iR + 16, iC + 6) 'ActiveCell.Offset(16, 6)
nbnotes = Cells(iR + 2, iC + 1) 'ActiveCell.Offset(2, 1)
notesource = Cells(1, col)
ligneencours = ligneclasse
'ActiveCell.Offset(0, 7).Select
iR = 2: iC = 101 + 7
...Bref, les problèmes commencent colonne CV (100); ligne 351 (ActiveCell...) parce que tu veux faire un collage sur une zone qui comporte de multiples données (des SOMMEPROD et quelques formules matricielles...) qu'il n'y a pas dans les lignes précédentes.
A+
Bonjour,
j'ajouterais pour une simple copie de ne pas utiliser la méthode Paste mais juste de bien utiliser la méthode Copy
en précisant directement la destination, consulter l'aide VBA …
Wow, merci pour les conseils!
Oui James, j'ai déjà réduit ledit fichier de 95%, en fait, vous avez le plus petit fichier possible pour voir où il plante.
Galopin, tes conseils me seront précieux pour accélérer le code en plus. Ne sachant pas comment programmer autrement (je suis entre le novice et le débutant) je me débrouillais avec ce que je savais, et bien que les offset soit un vrai jeu de battleship, c'est assez simple. Je vais remplacer mon code avec ce que tu me proposes, parce que les offset.select, c'est lent et quand on cherche l'erreur, c'est fou comment ça prend du temps! Tu as bien raison.
Pour ce qui est de copy plutôt que le paste que j'ai découvert en lisant beaucoup, je n'ai pas essayé parce je croyais qu'en agissant ainsi, que ça faisait juste déposer les valeurs dans les cellules et non les calculs. Je vais regarder de ce côté aussi.
Je souhaite pouvoir revenir à mon fichier ce soir