IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Problème de relation entre subs simples [XL-2013]


Sujet :

Macros et VBA Excel

  1. #1
    Candidat au Club
    Homme Profil pro
    ingénieur calcul en BE
    Inscrit en
    Janvier 2016
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : ingénieur calcul en BE
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2016
    Messages : 4
    Points : 2
    Points
    2
    Par défaut Problème de relation entre subs simples
    Bonjour,

    J'ai un fichier de test très simple avec une plage de cellules nommée qui contient des nombre dans les X cases du haut. J'ai réussi à faire une macro (sans paramètre) qui donne la X+1ème cellule mais quand j'utilise une autre macro ayant en paramètre la plage dont on veut trouver la première case vide j'ai un problème. J'ai cherché moi-même et puis partout sur le net et je n'ai pas réussi à trouver quelque chose qui règle les différentes erreurs. voilà le code (dans mon fichier I8:I16 est nommé toto) :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    Option Explicit
     
    Public toto As Range
     
    Function dernière(pipo As Range)
     
        'Static toto As Range
        'Static pipo As Range
     
        'Application.EnableEvents = False
     
        pipo.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("A1").Select
        dernière = Selection
     
        'Application.EnableEvents = True
     
    End Function
     
    Sub écrit()
     
    MsgBox = dernière.Offset(-1, 0).Value
     
    End Sub
     
    Sub plop()
     
    Call dernière(toto)
     
    End Sub
     
    Function dernièreSIMPLE()
     
        'Range("I8:I16").End(xlDown).Select
        'ActiveCell.Offset(1, 0).Range("A1").Select
        'dernièreSIMPLE = Selection
     
        dernièreSIMPLE = Range("I8:I16").End(xlDown).Offset(1, 0).Select
     
    End Function
    Le problème doit très certainement être simple. J'ai supposé que c'était lié au formats mais je n'ai pas trouvé. Et j'ai pensé qu'il faudra que je vérifie ce qu'il se passe quand la plage est vide une fois la macro fonctionnera.
    PS : les lignes de commentaires sont liées aux différentes solutions que j'ai essayé pour traiter le problème.

    Merci si vous pouvez me filer un petit coup de main.

  2. #2
    Expert éminent

    Homme Profil pro
    Curieux
    Inscrit en
    Juillet 2012
    Messages
    5 073
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Curieux
    Secteur : Arts - Culture

    Informations forums :
    Inscription : Juillet 2012
    Messages : 5 073
    Points : 9 853
    Points
    9 853
    Billets dans le blog
    5
    Par défaut
    Bonjour,

    sans fonction :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    Sub Test()
    Dim LaPlage As Range
        Set LaPlage = ThisWorkbook.Worksheets("Feuil1").Range("TOTO")
        MsgBox LaPlage.Address
        MsgBox LaPlage.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Address
    End Sub
    si tu dois réutiliser ça dans pas mal de procédure, inspire toi de cet exemple qui travaille sur l'objet Range :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Sub TestAvecFonction()
    Dim LaPlage As Range
    Dim LaDerniereCellule As Range
        Set LaPlage = ThisWorkbook.Worksheets("Feuil1").Range("TOTO")
        Set LaDerniereCellule = LaDerniere(LaPlage)
        MsgBox LaDerniereCellule.Address
    End Sub
     
    Function LaDerniere(Plage As Range) As Range
    Set LaDerniere = Plage.SpecialCells(xlCellTypeLastCell).Offset(1, 0)
    End Function

  3. #3
    Candidat au Club
    Homme Profil pro
    ingénieur calcul en BE
    Inscrit en
    Janvier 2016
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : ingénieur calcul en BE
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2016
    Messages : 4
    Points : 2
    Points
    2
    Par défaut
    Bonjour et un grand merci joe levrai, je m'excuse pour le retard j'étais pris par le boulot.
    Tu as réglé plusieurs problèmes. Ton code fonctionne parfaitement et répond exactement à mon besoin une fois remplacé "SpecialCells(xlCellTypeLastCell)" par "End(xlDown)" dans le petit fichier test.
    Cependant que j'utilise une des deux versions dans mon code, ça ne fonctionne plus (2 erreurs différentes).

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    Function Derniere(Plage As Range) As Range
    Set Derniere = Plage.End(xlDown).Offset(1, 0)
    End Function
     
     
    Sub Piocher(NbCarte As Integer)
     
        Dim LaPlage As Range
        Dim LaDerniereCellule As Range
        Set LaPlage = ThisWorkbook.Worksheets("Feuil1").Range("Main")
        Set LaDerniereCellule = Derniere(LaPlage)
     
     
        Dim i As Integer
        For i = 1 To NbCarte
            Range("C6").Cut
            LaDerniereCellule.Paste
            Range("C7:C65").Cut
            Range("C6:C64").Paste
        Next
     
        Application.CutCopyMode = False
     
    End Sub
    "Main" est une plage définie de la même manière que celle qui fonctionne avec ton exemple. (le nom de "Main" ne pose pas de problème car j'ai les même erreurs en le changeant)
    Je ne vois pas d'où vient l'erreur car comme je le pense et comme tu l'as fait remarqué dans ta réponse, on travaille avec des range.
    J'ai donc peur que ta réponse ne me suffise pas.

  4. #4
    Expert éminent

    Homme Profil pro
    Curieux
    Inscrit en
    Juillet 2012
    Messages
    5 073
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Curieux
    Secteur : Arts - Culture

    Informations forums :
    Inscription : Juillet 2012
    Messages : 5 073
    Points : 9 853
    Points
    9 853
    Billets dans le blog
    5
    Par défaut
    Bonjour,

    quel est le message d'erreur, et sur quelle ligne ?

    ta plage Main contient au moins 2 cellules ? Cette plage dispose-t-elle encore d'une cellule vide ou tout est rempli ? D'ailleurs, comment est définie ta plage dans Excel (dynamiquement ou avec une plage totalement fixe)

    pourquoi le specialcells a dû être modifié par un End(XlDown) ?


    Ps : ceci n'est pas un interrogatoire

  5. #5
    Candidat au Club
    Homme Profil pro
    ingénieur calcul en BE
    Inscrit en
    Janvier 2016
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : ingénieur calcul en BE
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2016
    Messages : 4
    Points : 2
    Points
    2
    Par défaut
    Alors voilà les réponses à tes questions dans l'ordre :

    1) avec End(xldown) : 1004 erreur définie pas l'application ou par l'objet à la ligne Set Derniere = Plage.End(xlDown).Offset(1, 0).
    avec SpecialCells(xlCellTypeLastCell) : 438 Propriété ou méthode non gérée par cet objet à la ligne LaDerniereCellule.Paste.

    2)la mplage Main contient 14 cellules
    elles sont vides pour le moment (elles se rempliront avec la pioche), en remplir une ne change rien à l'erreur
    la plage est définie de manière fixe

    3) avec SpecialCells ça me retournait la cellule sous la plage et non la première cellule vide DANS la plage.

    Encore merci pour la fulgurance de tes réponses !

  6. #6
    Candidat au Club
    Homme Profil pro
    ingénieur calcul en BE
    Inscrit en
    Janvier 2016
    Messages
    4
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : ingénieur calcul en BE
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2016
    Messages : 4
    Points : 2
    Points
    2
    Par défaut
    Et voilà un code (non optimisé à mon avis vu le nombre de select et les copier-coller-suppr) qui fonctionne.



    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    Function Derniere(Plage As Range) As Range
     
        'Dim debut As Range
        'Set debut = Range("E6")
     
        Set Derniere = Plage.End(xlDown).Offset(1, 0)
     
    End Function
     
     
    Sub Piocher(NbCarte As Integer)
     
        Dim LaPlage As Range
        Dim LaDerniereCellule As Range
        Set LaPlage = Range("E6")  'ThisWorkbook.Worksheets("Feuil1").Range("Main")
     
        Application.CutCopyMode = False
     
        Dim i As Integer
     
        For i = 1 To NbCarte
     
            Set LaDerniereCellule = Derniere(LaPlage)
     
            Range("C6").Select
            Selection.Copy
            LaDerniereCellule.Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
     
            Range("C7:C65").Select
            Selection.Copy
            Range("B6").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
     
            Range("C6:C65").Select
            Selection.ClearContents
     
            Range("B6:B64").Select
            Selection.Copy
            Range("C6").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
     
            Range("B6:B64").Select
            Selection.ClearContents
        Next
     
        Range("Q10").Select
     
    End Sub
     
    Sub Départ()
     
        Application.ScreenUpdating = False
     
        'on vide tout les emplacements
        Range("Deck").ClearContents
        Range("Main").ClearContents
        Range("Champ").ClearContents
        Range("Cimetière").ClearContents
        Range("Exile").ClearContents
        Range("Réserve").ClearContents
     
        'on remplit le deck
        Dim i As Integer
        For i = 1 To 60
            Range("C" & 5 + i).Value = i
        Next
     
        Call Mélange
     
        Piocher (7)
     
        Application.ScreenUpdating = True
     
    End Sub
     
    Sub Mélange()
     
        Application.ScreenUpdating = False
     
        Range("C6:D65").Select
        Selection.AutoFilter
        Selection.AutoFilter       'si je retire cette ligne les flèches de tri reste à la fin de la procédure
        ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("D6:D65") _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Feuil1").Sort
            .SetRange Range("C6:D65")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
     
        Range("Q5").Select
     
        Application.ScreenUpdating = True
     
    End Sub
    Le seul problème est que cela ne marche pas quand la "main" (E6 et les suivantes) est vide. J'y travaille


    Merci encore pour le coup de main.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Problème de relation entre 2 tables
    Par LUCAS-28 dans le forum Modélisation
    Réponses: 6
    Dernier message: 18/10/2007, 23h49
  2. [Conception]problème de relation entre les tables
    Par vaness76 dans le forum Modélisation
    Réponses: 3
    Dernier message: 18/04/2007, 11h32
  3. [Conception] Problème de relation entre 2 tables
    Par mLk92 dans le forum PHP & Base de données
    Réponses: 9
    Dernier message: 20/10/2006, 15h39
  4. [DEBUTANT]Problème de relation entre deux tables
    Par Yomane dans le forum Schéma
    Réponses: 2
    Dernier message: 20/10/2006, 01h30
  5. Problème de relation entre deux tables + autre chose
    Par Goth_sensei dans le forum Langage SQL
    Réponses: 7
    Dernier message: 30/03/2006, 20h49

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo