erreur d'execution de macro dont je ne trouve pas la cause

ebinet

XLDnaute Nouveau
Bonjour,

J'ai une macro qui plante parfois sans que je parvienne à trouver la cause (mes connaissances en VBA sont rudimentaires).
j'ai mis la macro ci après juste pour vous donner une idée des compétences requises mais sans le fichier pour essayer cela n'a pas vraiment d'intéret.
Le fichier pesant 5 mo, vous pouvez le télécharger à cette adresse :

Free - Envoyez vos documents

Le bug intervient lors de l'éxécution de la macro du boution "trier" sur la feuille "marc".
Pourtant, ce n'est pas un problème de données car en copiant les données qui sont triées (de la cellule A2 à E25) sur la feuille "réserve" la macro fonctionne.

C'est comme si des données invisibles étaient présentes plus bas dans la feuille. Mais même en effaçant le contenu des cellules situées en dessous des cellules et jusqu'à la ligne 1000 (comme spécifié dans la macro) cela bug toujours....

Votre aide serait la bienvenue et bein sur je reste à disposition pour expliquer le focntionnement de la macro.

Cordialement

Emmanuel





Sub trier()

' deprotéger la feuille
ActiveSheet.Unprotect



'effacer le contenu des colonnes G et H
Range("G2:H1000").Select
Selection.ClearContents

'trier les lignes
Range("A2:E1000").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


'effacer les #
Dim Plage As Range
Dim Cell As Range

Set Plage = Range("C2:C" & Range("C1000").End(xlUp).Row)

For Each Cell In Plage
If Cell.Value = "#" Then
Cell.Clear
End If
Next Cell



Dim c As Range
Dim firstAddress As String
Dim ChaineSelection As String
Dim I As Double

Application.ScreenUpdating = False

'efface les lignes contenant #
ChaineSelection = ""
With Range("C2", Range("C1000").End(xlUp).Address)
Set c = .Find("#", After:=Range("C2"))
If Not c Is Nothing Then
firstAddress = c.Address
Do
ChaineSelection = ChaineSelection & Range(c.Offset(0, -2), c.Offset(0, 2)).Address & ","

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
ChaineSelection = Mid(ChaineSelection, 1, Len(ChaineSelection) - 1)
Range(ChaineSelection).Delete shift:=xlUp
End If
End With


'insère les lignes avec des # autant de fois qu'il y a d'heures spécifiées
For I = Range("E1000").End(xlUp).Row To 2 Step -1
If Range("E1").Offset(I - 1, 0) > 1 Then
Range(Range("A1").Offset(I, 0), Range("E1").Offset(Range("E1").Offset(I - 1, 0) + I - 2, 0)).Insert shift:=xlDown
Range(Range("C1").Offset(I, 0), Range("C1").Offset(Range("E1").Offset(I - 1, 0) + I - 2, 0)) = "#"
End If
Next

'inscrie les jouurs de la semaine autant de fois qu'ils comportent d'heure
Dim vLigne As Double

vLigne = 1
For I = 1 To Range("J1000").End(xlUp).Row - 1
If Range("k1").Offset(I, 0) > 0 Then
Range(Range("G1").Offset(vLigne, 0), Range("G1").Offset(vLigne + Range("k1").Offset(I, 0) - 1, 0)) = Range("J1").Offset(I, 0)
vLigne = vLigne + Range("k1").Offset(I, 0)
End If
Next


' recopier la formule de H2 à H1000
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-4]),"""",RC[-4]-(RC[-1]+2))"
Range("H2:H1000").Select
Selection.FillDown


'enlever protection cellule
Range("A2:I1000").Select
Selection.Locked = False



'se positionner en B2
Range("B2").Select


Application.ScreenUpdating = True


End Sub
 

skoobi

XLDnaute Barbatruc
Re : erreur d'execution de macro dont je ne trouve pas la cause

Bonjour,

le soucis se trouve ici:

Code:
'insère les lignes avec des # autant de fois qu'il y a d'heures spécifiées
For I = Range("E1000").End(xlUp).Row To 2 Step -1
If Range("E1").Offset(I - 1, 0) > 1 Then
[COLOR=Red][B]Range(Range("A1").Offset(I, 0), Range("E1").Offset(Range("E1").Offset(I - 1, 0) + I - 2, 0)).Insert shift:=xlDown[/B][/COLOR]
Range(Range("C1").Offset(I, 0), Range("C1").Offset(Range("E1").Offset(I - 1, 0) + I - 2, 0)) = "#"
End If
Next

Il faudrait que tu expliques selon quel critère tu défini cette plage car dans l'état actuel elle comme ceci: A26:E44
Tu veux insérer en prenant des lignes vides, donc ça plante...
 

ebinet

XLDnaute Nouveau
Re : erreur d'execution de macro dont je ne trouve pas la cause

Bonjour,

Merci pour votre aide. j'aimerai pouvoir répondre à ta question Skoobi malheureusement je ne sais pas.

Je peux expliquer le but de la macro en espérant que cela aide.

La macro "trier" trie les lignes de la plage A1 à E1000 selon les données des colonnes B (P) et D (date de livraison). Trie en ordre croissant.

Une fois les lignes triées, la macro recopie chaque ligne autant de fois qu'il y a de temps de fabrication (spécifié dans la colonne E) (chaque ligne correspond à un temps d'une heure, donc une fabrication nécessitant 5 heures occupera 5 lignes) mais la ligne contenant les informations n'est inscrite en fait qu'une fois et est suivi du signe #. Donc par exemple une fabrication qui nécesite 5 heures de travail sera incrit sur une ligne puis suivi de 4 lignes comportant le signe #

Apparemment, c'est sur cette partie de code que cela bloque parfois.

Je pourrais expliquer le reste du fonctionnement de la macro mais je pense pas que cela soit nécessaire dans la mesure où elle semble bloquer sur la partie que j'ai décrite.

Pour visualiser le fonctionnement normal de la macro, il suffit de copier la plage A2:E25 de la feuille "marc" sur la la feuille "réserve" et de lancer la macro "trier".

Espérant que cela aidera à trouver le dysfonctionnement.

Cordialement
 

skoobi

XLDnaute Barbatruc
Re : erreur d'execution de macro dont je ne trouve pas la cause

Re bonjour,

La dernière ligne "non vide" pour excel est la dernière, 65536.
appuie sur la touche "fin" puis "débur".
Pourquoi?, mystère (tu peux le constater avec la barre de défilement vertical).
Supprime toutes ces lignes "non vide" et tout rentrera dans l'ordre.
 

ebinet

XLDnaute Nouveau
Re : erreur d'execution de macro dont je ne trouve pas la cause

Bonjour skoobi,


j'ai rajouté un bout de code pour supprimer les lignes depuis la 1000 jusqu'à la 65536 et effectivement cela évite le bug...
Je n'ai pas compris toutes les subtilités du truc mais cela fonctionne grâce à ton aide, et c'est ce qui compte pour moi.

Merci encore.

Emmanuel
 

Discussions similaires

Statistiques des forums

Discussions
314 653
Messages
2 111 578
Membres
111 205
dernier inscrit
Adrien25