Erreur macro incompréhensible

a_loic

XLDnaute Junior
Bonjour,

je dois travailler depuis trop de temps sur ma macro et je ne trouve pas l'erreur ...

voici le code :
Code:
Sheets("Importation").Select
If Cells.Find("*") Is Nothing Then
MsgBox "Merci de ne pas laisser l'onglet d'importation vide"
  Sheets("Intervention").Select
Else

Sheets("Feuil1").Visible = True

Dim Vligne1, Vligne2  As Integer
Dim Vcode As String

Sheets("Importation").Select
Range("D1").Select

5 If ActiveCell.Value <> "Nom du module" Then

            If ActiveCell.Offset(0, 20).Range("A1").Value = "Fin de la feuille" Then
                GoTo 100
            End If

    n = n + 1

    Range("D" & n).Select

    GoTo 5
  Else

            If ActiveCell.Offset(0, 3).Range("A1").Value = "recuperation1" Or _
                ActiveCell.Offset(0, 3).Range("A1").Value = "recuperation2" Or _
                ActiveCell.Offset(0, 3).Range("A1").Value = "recuperation3" Or _
                ActiveCell.Offset(0, 3).Range("A1").Value = "recuperation4" Then

                Vcode = ActiveCell.Offset(0, 3).Range("A1").Value

                n = n + 3
                Range("D" & n).Select

                Do While ActiveCell.Value = "" Or ActiveCell.Value = "Identifiant"
                    n = n + 1

                    Range("D" & n).Select
                    
                Loop

                Vligne1 = ActiveCell.Row

                Do While ActiveCell.Value <> "Nom du module" And Not ActiveCell.Offset(0, 20).Range("A1").Value = "Fin de la feuille"
                    n = n + 1

                    Range("D" & n).Select
                Loop

                Vligne2 = ActiveCell.Row - 1

                Range("D" & Vligne1 & ":AO" & Vligne2).Copy

                Sheets("Feuil1").Select
                If Range("B1").Value = "" Then

                   Range("B1").Select
                   ActiveSheet.Paste
                Else

                    Range("B1").Range("A1:L1").End(xlDown).Select
                    ActiveCell.Offset(1, 0).Range("A1").Select
                    ActiveSheet.Paste
                End If

                ActiveCell.Offset(0, -1).Range("A1:A" & Vligne2 - Vligne1).Value = Vcode
                

                Range("A1").End(xlDown).Select

                Do While ActiveCell.Value = Vcode And Not ActiveCell.Address = "$A$1"
                    If ActiveCell.Offset(0, 1).Range("A1").Value = "" Then

                        ActiveCell.Rows("1:1").EntireRow.Delete Shift:=xlUp
                    End If
                    ActiveCell.Offset(-1, 0).Range("A1").Select
                Loop

                Sheets("Importation").Select

                GoTo 5
            Else
                n = n + 3
                Range("D" & n).Select

                GoTo 5
    End If
End If

100
Sheets("Feuil1").Select


Range("C:N,P:P,R:X,Z:AD,AF:AM").Delete

With Range("A:F")
Cells.SpecialCells(xlCellTypeConstants).Select
End With

    Selection.Copy
    Sheets("Intervention").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("Feuil1").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Sheets("Feuil1").Select
    ActiveWindow.SelectedSheets.Visible = False

Mon problème : lors de certaines importations j'ai un message d'erreur. Je pense que cela est dû au fait qu'il peut y avoir dans mon fichier toutes les infos (recuperation 1, 2, 3 et 4), comme une seule des infos, mais parfois aucune. On peut aussi trouver plusieurs fois le même point avec des infos différentes sous chacune...
-> j'espère être assez clair...

Je ne vois pas dans mon code a quel moment j'ai oublié de spécifier cela.

De plus, la phrase "Fin de la feuille", se trouve bien en bas de toutes les copies, seulement, lorsque ma macro bug la macro tourne jusqu'en bas de la feuille au lieu de s'arrêter à cette phrase...

Arrivez vous à voir mon erreur?

Merci d'avance,
 

gosselien

XLDnaute Barbatruc
Re : Erreur macro incompréhensible

Bonsoir,

perso j'y vois pas mal d'erreur et la première serait la déclaration de tes variables qui devrait être en haut de ton code, ensuite tu devrais "indenter" ton code avec un "smart indenter"qui permet de mieux lire son code...
il est ici : Office Automation Ltd.

et pour ton code, je vois déjà une erreur :
If ActiveCell.Offset(0, 20).Range("A1").Value ="........"
il testera toujours sur A1 donc tu dois retirer ton range("A1") :)
pour savoir quelle est la cellule active, tu peux ajouter dessous
début.print activecell.address

et par la fenêtre 'exécution (CTRL-G) depuis l'éditeur VBA tu auras l'adresse en question...
Pour le reste, tu devrais, comme conseillé mettre un fichier d'exemple pour que les chefs ici se penchent sur le bébé..
 

a_loic

XLDnaute Junior
Re : Erreur macro incompréhensible

Bonsoir,

Je ne connais pas la fonction pour "indenter", je vais tester cela ce soir :)

En ce qui concerne le fichier d'exemple, j'en ai mis un en pièce jointe.

A savoir, au risque de me répéter, mon exemple est simple et ma macro fonctionne dessus...
Cependant, voici un résumé de ce qu'on peut trouver.

Il y a 3 groupes : "eco", "default" et "return".
Ces 3 groupes rassemblent des modules nommés recuperation, ils sont au nombre maximal de 10 ("recuperation1", "recuperation2" ...). Pour mon importation, seuls les 4 premiers sont importants.

La difficulté que je rencontre réside dans le fait que :
1. les 4 recuperations qu'il me faut peuvent être divisés dans les 3 groupes (donc 3 "recuperation1" à importer)
2. le nombre de lignes entre le nom du module et les données peut varier selon les fichiers
3. il peut très bien y avoir les 10 recuperations dans les 3 groupes, mais également, aucun recuperation qui m'interesse (ni 1, 2, 3 ou 4)

J’espère qu'avec l'exemple ce sera plus clair...
 

Pièces jointes

  • test_importation.xls
    96.5 KB · Affichages: 19

gosselien

XLDnaute Barbatruc
Re : Erreur macro incompréhensible

pour l'indentation, c'est un petit logiciel "add on" à télécharger et qui n'est donc pas dans excel :)
pour ton code VBA, comme indiqué, je ne suis pas assez "costaud" pour t'aider, je le reconnais mais je peux voir qq petites erreurs en le parcourant.
J'espère que l'un des nombreux excellistes vba pourront t'aider :)

P.
 

a_loic

XLDnaute Junior
Re : Erreur macro incompréhensible

Bonjour à tous,

je reviens vers vous car malgré que j'avais trouvé ma solution, sur tous les fichiers testés, un seul me fait de la résistance et je crois que la raison me dépasse. :eek:

Je vous mets en pièce jointe le nouveau fichier.

De plus, j'ai remarqué que de nombreuses lignes ressortent en double.
Est il possible de les filtrer pour ne copier qu'une ligne par module?
Les doublons entre groupes (= "eco", "default" et "return") sont pratiques mais pas dans un même module (recuperation1, recuperation2...).

Merci d'avance,
Bonne journée,;)
 

Pièces jointes

  • Test_importation_test2.xls
    86.5 KB · Affichages: 14
  • Test_importation_test2.xls
    86.5 KB · Affichages: 25
  • Test_importation_test2.xls
    86.5 KB · Affichages: 26

camarchepas

XLDnaute Barbatruc
Re : Erreur macro incompréhensible

Bonjour ,

9a a un peu chauffé , y'a plus grand chose d'origine , mais je crois que ça donne le résultat excompté .

Code:
Sub Report()

Dim Trouve As Range
Dim PremiereAdresse As String
Dim info(10) As String
Dim DerLigne As Long
With Sheets("Importation")
    Set Trouve = .Range("I:I").Find(":", lookat:=xlPart, LookIn:=xlValues)
    If Not Trouve Is Nothing Then
        PremiereAdresse = Trouve.Address
        Do
            info(1) = Trouve.Offset(0, 2)
            info(0) = .Range("Z" & Trouve.Row)
Encore:
            info(2) = .Range("d" & Trouve.Row + 7)
            info(3) = .Range("q" & Trouve.Row + 7)
            info(4) = .Range("s" & Trouve.Row + 7)
            info(5) = .Range("AA" & Trouve.Row + 7)
            info(6) = .Range("AG" & Trouve.Row + 7)
            DerLigne = Sheets("Intervention").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Intervention").Range("A" & DerLigne) = info(1)
            Sheets("Intervention").Range("B" & DerLigne) = info(2)
            Sheets("Intervention").Range("C" & DerLigne) = info(3)
            Sheets("Intervention").Range("D" & DerLigne) = info(4)
            Sheets("Intervention").Range("E" & DerLigne) = info(5)
            Sheets("Intervention").Range("F" & DerLigne) = info(6)
            If info(0) > 1 Then info(0) = info(0) - 1: GoTo Encore
            Set Trouve = .Range("I:I").FindNext(Trouve)
        Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresse
    End If
End With

End Sub
 

Pièces jointes

  • Test_importation_test2.xls
    89 KB · Affichages: 26
  • Test_importation_test2.xls
    89 KB · Affichages: 24
  • Test_importation_test2.xls
    89 KB · Affichages: 20

a_loic

XLDnaute Junior
Re : Erreur macro incompréhensible

Bonsoir,

excellent code beaucoup plus light et rapide !

Malheureusement je ne comprends pas toujours comment il fonctionne.

Il y a 2 choses qu'il ne fait pas :

- importer seulement les recuperation1, recuperation2, recuperation3 et recuperation4 et ne pas toucher aux autres.

- supprimer les doublons, par exemple dans le fichier fourni, l'importation du N° 27 ticket 10 (la location de Marc) est présente 33 fois alors qu'une seule me suffit...

Je vous remercie infiniment pour ce que vous avez déjà fait, l'allègement de ma macro est incroyable, pensez vous que mes 2 points restants sont possibles?

Bonne soirée,

edit : je viens de tester avec une autre importation (voir pièce jointe) et il y a une erreur car l'importation se fait sauf que le N° et le ticket est le même par module... je ne suis peut être pas clair mais c'est visible dans l'exemple.
 

Pièces jointes

  • Test_importation_test3.xls
    104 KB · Affichages: 15
Dernière édition:

camarchepas

XLDnaute Barbatruc
Re : Erreur macro incompréhensible

Re ,


@ Gosselien : Je pourrais effectivement serrer à 7 , mais j'aime bien avoir un peu de réserve lorsque j'ai pas tous les éléments en main .
Là , je viens d'ajouter un item , cela évite de redéclarer en pleine mise au point .... , mais dans le fond tu as raison .

Effectivement , j'ai vu le truc ,

Alors juste les bonnes récup sans les doublons et avec toutes les infos ...

enfin j'espère :

Code:
Sub Report()

Dim Trouve As Range
Dim PremiereAdresse As String
Dim Info(10) As String
Dim DerLigne As Long, Ligne As Long
Dim Dico As Object
Dim Interv As Worksheet
Set Interv = Worksheets("Intervention")
Set Dico = CreateObject("Scripting.Dictionary")
With Sheets("Importation")
    Set Trouve = .Range("I:I").Find(":", lookat:=xlPart, LookIn:=xlValues)
    If Not Trouve Is Nothing Then
        PremiereAdresse = Trouve.Address
        Do
            Info(1) = Trouve.Offset(0, 2)
            If Split(Info(1), "recuperation")(1) < 5 Then
              Ligne = Trouve.Row
              Info(0) = .Range("Z" & Ligne)
Encore:
              Info(2) = .Range("d" & Ligne + 7)
              Info(3) = .Range("q" & Ligne + 7)
              Info(4) = .Range("s" & Ligne + 7)
              Info(5) = .Range("AA" & Ligne + 7)
              Info(6) = .Range("AG" & Ligne + 7)
              Info(7) = Info(2) & Info(3) & Info(4)
              If Not Dico.exists(Info(7)) And Info(2) <> "" Then
                Dico.Add Info(7), ""
                DerLigne = Interv.Range("A" & Rows.Count).End(xlUp).Row + 1
                Interv.Range("A" & DerLigne) = Info(1)
                Interv.Range("B" & DerLigne) = Info(2)
                Interv.Range("C" & DerLigne) = Info(3)
                Interv.Range("D" & DerLigne) = Info(4)
                Interv.Range("E" & DerLigne) = Info(5)
                Interv.Range("F" & DerLigne) = Info(6)
              End If
              If Info(0) > 1 Then Info(0) = Info(0) - 1: Ligne = Ligne + 1: GoTo Encore
            End If
            Set Trouve = .Range("I:I").FindNext(Trouve)
        Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresse
    End If
End With

End Sub
 

Pièces jointes

  • Test_importation_test2.xls
    85 KB · Affichages: 15
  • Test_importation_test2.xls
    85 KB · Affichages: 25
  • Test_importation_test2.xls
    85 KB · Affichages: 26
Dernière édition:

camarchepas

XLDnaute Barbatruc
Re : Erreur macro incompréhensible

Et oui ,

bingo , Mac Mac . je crois avoir vu un truc sur XLD pour simuler le dico pour le mac .

@ Gosselien Pas besoin de référencer grace à la déclaration tardive :
Dim Dico As Object
Dim Interv As Worksheet
Set Interv = Worksheets("Intervention")
Set Dico = CreateObject("Scripting.Dictionary")


J'ai pas trop le temps de chercher aujourd'hui , Planning hyper Up ce jour ,

Je repasse donc ce soir pour voir comment traiter l'affaire.

Bonne journée
 

Discussions similaires

Réponses
2
Affichages
145

Statistiques des forums

Discussions
312 299
Messages
2 086 991
Membres
103 422
dernier inscrit
victus5