Copie avec condition

Résolu
HAXitoo -  
Bonjour,

Je souhaite coller une information dans une autre feuille sous condition que cette information figure dans une autre feuille.

Objectif : Si dans la colonne D de la Feuil1 la cellule correspond à une cellule dans la colonne D de la Feuil5, je veux que celui ci soit reporter dans la colonne A de la Feuil2.

Voici mon code: 

Private Sub Worksheet_Activate()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim i As Integer
    Dim j As Integer
    
    j = 5

For i = 5 To 250
    'Si dans la feuille 1 l'information correspond à une base de donnée dans la feuille 5
    If Feuil1.Range("D" & i).Value = Feuil5.Columns("D" & i) Then

    'Copier l'information de la feuille 1 à la feuille 2
    Feuil2.Range("A" & j).Value = Feuil1.Range("D" & i).Value
    End If
    
    Next
    Application.EnableAnimations = True
    Application.ScreenUpdating = True

End Sub
Mon problème se situe ici Feuil5.Columns("D" & i) si je remplace par Feuil5.Columns("D5") ça fonctionne, mais que pour cette cellule et je voudrais qu'il recherche dans toute la colonne.

Merci d'avance pour l'aide.

15 réponses

  • Votes
  • Date
  • Date décroissante
Résumé de la discussion

Le besoin est de reporter vers Feuil2!A(j) la valeur de Feuil1!D(i) lorsque cette valeur figure dans la colonne D de Feuil5. Le problème provient du test Feuil5.Columns("D" & i), qui ne cible qu’une cellule et non toute la colonne. Utiliser WorksheetFunction.CountIf(Feuil5.Columns("D"), Feuil1.Range("D" & i).Value) ou Application.Match permet de tester l’appartenance à l’ensemble de la colonne. Exemple: For i = 5 To 250: If WorksheetFunction.CountIf(Feuil5.Columns("D"), Feuil1.Range("D" & i).Value) > 0 Then Feuil2.Range("A" & j).Value = Feuil1.Range("D" & i).Value: j = j + 1: End If: Next i.

Bobot (l’IA à votre service)
  2. pijaku Modérateur
    Bonjour,

    Si j'ai bien compris, l'utilisation de la Fonction Excel "CountIf" te permettra de savoir si ta cellule Feuil1D & i se trouve bien dans la colonne D feuil5. 

    Dim MonTab, i As Integer, j As Integer, MaVal As String
'On stocke les données de la colonne D Fuil1 dans une variable tableau
With Sheets("Feuil1")
   MonTab = .Range("D1:D" & .Range("D" & Rows.Count).End(xlUp).Row)
End With
With Sheets("Feuil5")
   j = 2
   For i = 1 To UBound(MonTab, 1)
       MaVal = MonTab(i, 1)
       If WorksheetFunction.CountIf(.Columns(4), MaVal) > 0 Then
           Sheets("Feuil2").Cells(j, 1) = MaVal
           j = j + 1
       End If
   Next 
End With

    Cordialement,
    Franck
    1. HAXitoo Auteur
      Alors j'ai pas réussi a utlisé votre code, j'ai une erreur.
    2. pijaku Modérateur
      Alors j'ai pas réussi a utlisé votre code, j'ai une erreur.
      Ca manque un peu de précision...
      Quel code d'erreur? Qu'indique le débogage (ligne surlignée en jaune)? etc...

      De toutes façons, le code que je vous ai transmis est à adapter à votre situation. Personnellement, je l'ai testé, et il semble fonctionner...
      Après chaque classeur a ces particularités. Je ne connais pas les vôtres.

      Déjà une adaptation au niveau des lignes (vous commencez à la ligne 5) : 
      Dim MonTab, i As Integer, j As Integer, MaVal As String
'On stocke les données de la colonne D Fuil1 dans une variable tableau
With Sheets("Feuil1")
   MonTab = .Range("D5:D" & .Range("D" & Rows.Count).End(xlUp).Row)
End With
With Sheets("Feuil5")
   j = 5
   For i = 1 To UBound(MonTab, 1)
       MaVal = MonTab(i, 1)
       If WorksheetFunction.CountIf(.Columns(4), MaVal) > 0 Then
           Sheets("Feuil2").Cells(j, 1) = MaVal
           j = j + 1
       End If
   Next 
End With
    3. HAXitoo Auteur
      "L'indice n'appartient pas à la selection". J'ai essayé de l'adapter mais il bloque ici: 

      MonTab = .Range("D1:D" & .Range("D" & Rows.Count).End(x1Up).Row)
    4.  pijaku Modérateur
      Classeur bien reçu.
      Dans ton code tu parles de Feuil1, Feuil2 et Feuil5. Cela correspond à qu'elles feuilles dans le classeur?
    5. HAXitoo Auteur
      Feuil1 = Informations
      Feuil2 = Statistiques
      Feuil5 = Base de données

      Le résultat que je souhaite c'est si dans la feuil1 on retrouve une valeur similaire à la feuil5, que cette valeur soit copier dans la feuil2. J'ai réussi à le faire avec cette formule mais avec une condition nominative. J'aurai pu la faire comme ça en nommant un par un tout le contenu de la colonne D, mais je voulais justement pas en arriver là et pas devoir modifier mon code à chaque fois que je modifie ma base de données.
  3. michel_m Contributeur
    salut pijaku

    j'aurais écrit
    dim montab()

    MonTab = .Range("D1:D" & .Range("D" & Rows.Count).End(x1Up).Row).value

    -- Michel
    1. pijaku Modérateur
      Salut Michel,

      Oui, en effet.
      Par contre, qu'elle est la réelle influence de cette précision? Dim montab() et ajouter .Value utilise moins de mémoire?
      Parce que les 2 fonctionnent...

      Par contre, je ne serais pas de retour avant lundi... Soit HAXitoo est patient, soit tu peux prendre la suite...

      Note : le code donné fonctionne, il suffit de l'adapter au cas. Par contre, au vu du classeur (transmis en MP), je n'ai pas l'impression que la question ait été bien donné initialement...
      A voir.
    2. HAXitoo Auteur
      Alors je vais encore essayer avec le code que vous m'avez donné, j'ai du mal l'adapter. C'était sans doute mal expliquer de ma part, c'est toujours un peu difficile de poser son problème.

      Sinon, on se revoit lundi j'imagine. Je suis encore novice dans VBA, ça doit être pour ça que je n'ai pas réussi à le faire.
  4. HAXitoo Auteur
    J'ai vraiment du mal à comprendre sur ce que je fais de faux. 

    Private Sub Worksheet_Activate()

        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Dim MonTab(), i As Integer, j As Integer, MaVal As String
        
        With Sheets("Feuil1")
        MonTab = .Range("D1:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value 'Erreur d'éxecution 9 : L'indice n'appartient pas à la sélection.
        
        End With

        With Sheets("Feuil5")

        j = 2

        For i = 1 To UBound(MonTab, 1)

        MaVal = MonTab(i, 1)
        
        If WorksheetFunction.CountIf(.Columns(4), MaVal) > 0 Then

        Sheets("Feuil2").Cells(j, 1) = MaVal

        j = j + 1

        End If
        Next
        End With
        Application.EnableAnimations = True
        Application.ScreenUpdating = True

    End Sub
    2. michel_m Contributeur
      mettre un point devant rows
      MonTab = .Range("D1:D" & .Range("D" & .Rows.Count).End(xlUp).Row).Value

      bon WE

      Michel
      1. HAXitoo Auteur
        Non toujours pas bon...Je vais tenter de re-expliquer.

        Je travaille avec la colonne D de la Feuil1, la colonne A de la Feuil2 et la colonne D de la Feuil5. Si dans la Feuil1 dans la colonne D on retrouve une cellule similaire à une autre cellule qui se trouve dans la colonne D de la Feuil5, celle-ci doit être copier dans la colonne A de la Feuil2.
    3. HAXitoo Auteur
      Bonjour,

      Le week-end est passé, mais je n'ai malheureusement toujours pas pu résoudre mon problème.
      1. michel_m Contributeur
        Bonjour

        mets ton classeur en Pièce jointe: on va reprendre le problème à zéro

        pour joindre une pièce
        mettre le classeur sans données confidentielles en pièce jointe sur
        https://www.cjoint.com/
        puis copier l'adresse du lien et la coller dans le message de réponse
    4. pijaku Modérateur
      Bonjour,

      En attendant l'avis de Michel sur le classeur, je vous donne le mien.
      Le problème tient en deux choses.
      1- Application.EnableEvents = False doit absolument être TOUJOURS remis à true en fin de procédure.
      Ce n'est pas le cas dans le Application.EnableEvents = False de la feuille "Statistiques". L'erreur est d'avoir indiqué Application.EnableAnimations = True en fin de macro.

      2- Il faut indiquer dans le code, le nom exact des feuilles.

      Ce qui nous donne : 
      Private Sub Worksheet_Activate()
Dim MonTab(), i As Integer, j As Integer, MaVal As String

Application.EnableEvents = False
Application.ScreenUpdating = False
'Effacement des données contenues dans la feuille statistiques
With Sheets("Statistiques")
    '.Range("A5:A" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
End With
'On stocke les données de la colonne D Fuil1 dans une variable tableau
With Sheets("Informations")
'selon le conseil de michel_m utilisation de .Value
   MonTab = .Range("D5:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
End With
With Sheets("Base de données")
   j = 5
   For i = 1 To UBound(MonTab, 1)
       MaVal = MonTab(i, 1)
       If WorksheetFunction.CountIf(.Columns(4), MaVal) > 0 Then
           Sheets("Statistiques").Cells(j, 1) = MaVal
           j = j + 1
       End If
   Next
End With
Application.EnableEvents = True
'    Application.EnableAnimations = True 'INUTILE
Application.ScreenUpdating = True
MsgBox "fini"
End Sub


      Il convient donc :
      1- de placer ce code dans le module de la feuille "Statistiques"
      2- d'enregistrer le classeur
      3- fermer puis réouvrir afin de tester...
      Cordialement,
      Franck
      1. HAXitoo Auteur 
        Private Sub Worksheet_Activate()

        Dim MonTab(), i As Integer, j As Integer, MaVal As String

        Application.EnableEvents = False
        Application.ScreenUpdating = False 'Effacement des données contenues dans la feuille statistiques

        With Sheets("Statistiques") '.Range("A5:A" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents

        End With 'On stocke les données de la colonne D Fuil1 dans une variable tableau

        With Sheets("Informations") 'selon le conseil de michel_m utilisation de .Value

        MonTab = .Range("D5:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value

        End With

        With Sheets("Base de données")

        j = 5

        For i = 1 To UBound(MonTab, 1)

        MaVal = MonTab(i, 1)

        If WorksheetFunction.CountIf(.Columns(4), MaVal) > 0 Then

        Sheets("Statistiques").Cells(j, 1) = MaVal

        j = j + 1

        End If

        Next
        End With

        Application.EnableEvents = True '
        Application.EnableAnimations = True 'INUTILE
        Application.ScreenUpdating = True
        MsgBox "fini"

        End Sub

        Alors là, ça fonctionne.
        1. HAXitoo Auteur
          Bon alors ça fonctionne, par contre j'aurai une autre question, contrairement aux formulex que j'ai utilisé dans les autres feuilles, celui ci, prendre un peu plus de temps à "charger", alors que dans mes autres feuilles ça se fait instantanément. Peut-on réduire ce temps?
        2. pijaku Modérateur
          Peut être que la fonction WorksheetFunction.CountIf ralentit la procédure.
          Je n'ai pas d'info à ce sujet. Michel_m en aura certainement davantage.

          Pour la remplacer, peut être qu'en ajoutant une seconde variable tableau et en comparant avec Application.Match cela permettrait de gagner du temps... Ou pas!

          Essaie ceci (je n'ai pas testé) : 

          Private Sub Worksheet_Activate()
Dim MonTabFeuil1(), MonTabFeuil5(), i As Integer, j As Integer, MaVal As String

Application.EnableEvents = False
Application.ScreenUpdating = False
'Effacement des données contenues dans la feuille statistiques
With Sheets("Statistiques")
    '.Range("A5:A" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
End With
'On stocke les données de la colonne D Fuil1 dans une variable tableau
With Sheets("Informations")
'selon le conseil de michel_m utilisation de .Value
   MonTabFeuil1 = .Range("D5:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
End With
With Sheets("Base de données")
   MonTabFeuil5 = .Range("D5:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
End With
   j = 5
   For i = 1 To UBound(MonTabFeuil1, 1)
       MaVal = MonTabFeuil1(i, 1)
       On Error GoTo Suite
       If MaVal <> "" Then
          If Application.Match(MaVal, MonTabFeuil5, 0) > 0 Then
             Sheets("Statistiques").Cells(j, 1) = MaVal
             j = j + 1
          End If
       End If
Suite:
   Next
Application.EnableEvents = True
'    Application.EnableAnimations = True 'INUTILE
Application.ScreenUpdating = True
MsgBox "fini"
End Sub
        3. HAXitoo Auteur
          Okay, ça aurait été un plus, mais ce n'est qu'un détail. Encore quelques questions (promis, après j'arrête)

          1. Comment faire pour n'afficher qu'une seule fois la valeur? Car si j'ai bien compris la boucle, sert à recopier toute la colonne, mais je ne voudrais pas justement de doublons.

          2. Je veux appliquer ce que vous m'avez donner pour la colonne C, E et G, mais je n'ai pas réussi à le faire.
      2. pijaku Modérateur
        1- pour la "lenteur" de ce système, il faudrait voir également que les cellules Feuille "Informations", colonne D, de la ligne 53 à 1798 comptent comme étant "non-vide" en raison de la liste déroulante inclue dans ces cellules. Par conséquent, la boucle se fait sur 1790 lignes au lieu de 50...

        2- Comment faire pour n'afficher qu'une seule fois la valeur?
        deux choix.
        - utiliser un dictionary en plus de la variable tableau MonTabFeuil1 pour y stocker les valeurs uniques
        - utiliser une colonne intermédiaire.

        3- Je veux appliquer ce que vous m'avez donner pour la colonne C, E et G, mais je n'ai pas réussi à le faire
        Je n'ai pas compris ce que tu veux faire...
        1. HAXitoo Auteur
          1 - Alors je vais regarder si je peux faire ma feuille différemment.

          2 - Okay.

          3 - Le code sur lequel nous venons de travailler, n'est uniquement pour la colonne D, je veux faire la même chose avec la colonne C, E et G.

          Je pensais y arriver seul, mais je suis limité dans mes connaissances VBA et au vu de ma formule et la votre, je n'arrive toujours pas à comprendre pourquoi on le fait comme ça.

          (Bon c'est l'heure de manger, alors je vous dis bon appétit et à toute à l'heure)
        2. pijaku Modérateur
          Je poste ici la méthode avec dictionary.
          Pour le reste, tu parles de colonnes C E et G mais de qu'elle feuille? Faut-il vérifier si leur valeur est contenue quelque part???
          Donne des détails... 
          Private Sub Worksheet_Activate()
Dim MonTabFeuil1(), MonTabFeuil5(), i As Integer, MaVal As String, dico As Object

Application.EnableEvents = False
Application.ScreenUpdating = False

Set dico = CreateObject("Scripting.Dictionary")
'Effacement des données contenues dans la feuille statistiques
With Sheets("Statistiques")
    '.Range("A5:A" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
End With
'On stocke les données de la colonne D Feuil1 dans une variable tableau
With Sheets("Informations")
'selon le conseil de michel_m utilisation de .Value
   MonTabFeuil1 = .Range("D5:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
End With
With Sheets("Base de données")
   MonTabFeuil5 = .Range("D5:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
End With
   For i = 1 To UBound(MonTabFeuil1, 1)
       MaVal = MonTabFeuil1(i, 1)
       On Error GoTo Suite
       If MaVal <> "" Then
          If Application.Match(MaVal, MonTabFeuil5, 0) > 0 Then
             dico(MaVal) = ""
          End If
       End If
Suite:
   Next
 Sheets("Statistiques").Range("A5").Resize(dico.Count, 1) = Application.Transpose(dico.keys)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


          Bon appétit
        3. HAXitoo Auteur
          Alors les valeurs sont quelque part, c'est pour le même principe que pour la colonne D.

          La colonne C de la Feuil2 : doit contenir les mêmes valeurs que la colonne H de la Feuil1 si elles sont présentes dans la colonne E de la Feuil 5.

          La colonne E de la Feuil2 : doit contenir les mêmes valeurs que les colonnes I, J, K et L de la Feuil1 si elles sont présentes dans la colonne G de la Feuil5.

          La colonne G de la Feuil2 : doit contenir les mêmes valeurs que la colonne C de la Feuil1 si elles sont présentes dans la colonne C de la Feuil5.
        4. HAXitoo Auteur
          La formule que vous m'avez donnée fonctionne très bien ! Et il n'y a plus de temps de latence.
        5. pijaku Modérateur
          Pas assez précis...
          Je suppose qu'il faut aussi vérifier en fonction du contenu de la colonne D...
          Donc...
          La colonne C de la Feuil2 : doit contenir les mêmes valeurs que la colonne H de la Feuil1 si elles sont présentes dans la colonne E de la Feuil 5 et que la valeur contenue en D de la Feuil1 soit présente dans la même ligne feuil5

          Soit précis!
      3. michel_m Contributeur
        Re,

        Application.enableevents est inutile voire dangereuse dans un événement sheet activate

        j'ai donc ctéé dans un module cette roue de secours 
        Sub relancer_macros()
        Application.EnableEvents = True
        End Sub
        Si la macro rend la main au système, il est inutile de remettre screenupdating à True

        Proposition de code avec élimination des doublons en feuille info. j'ai cru comprendre que tu recherchais les fonctions du staff de la feuille info dans la base mais je ne vois pas le rappoe=rt avec les colonnes B et C.

        durée testée=0,14 sec
        apparemment, tu pourrais passer les types Integer en Byte 
        Option Explicit

        Private Sub Worksheet_Activate()
        Dim Derlig As Integer, Cptr As Integer, T_info(), T_base()
        Dim D_info As Object, D_base As Object
        Dim Lig As Integer, T_stats()
        'pour essai rapidité
        Dim Start As Single
        Start = Timer

          Application.ScreenUpdating = False
          '--------liste des fonctions feuille info sans doublons
          With Sheets("Informations")
             'mémorisation fonctions
             Derlig = .Columns("D").Find("*", , , , , xlPrevious).Row
             T_info = Application.Transpose(.Range("D5:D" & Derlig).Value)
             'création liste fonctions sans doublons
             Set D_info = CreateObject("scripting.dictionary")
             For Cptr = 1 To UBound(T_info)
                  If Not D_info.exists(T_info(Cptr)) Then D_info.Add T_info(Cptr), ""
             Next
             T_info = D_info.keys
          End With
          '--------liste des fonctions feuille base
          With Sheets("Base de données")
             'mémorisation fonctions
             Derlig = .Columns("D").Find("*", , , , , xlPrevious).Row
             T_base = Application.Transpose(.Range("D5:D" & Derlig).Value)
             'création liste fonctions
             Set D_base = CreateObject("scripting.dictionary")
             For Cptr = 1 To UBound(T_base)
                   D_base.Add T_base(Cptr), ""
             Next
          End With
          '--------restitution des fonctions existantes dans la base feuille stats
          ReDim T_stats(UBound(T_info))
          For Cptr = 1 To UBound(T_info)
            If D_base.exists(T_info(Cptr)) Then
                  T_stats(Lig) = T_info(Cptr)
                  Lig = Lig + 1
             End If
          Next
          With Sheets("Statistiques")
             .Range("A5:A2000").ClearContents
             .Range("A5").Resize(UBound(T_info), 1) = Application.Transpose(T_stats)
          End With
          'pour essai rapidité
          Application.ScreenUpdating = True
          MsgBox "liste effectuée en " & Timer - Start & " sec."
        End Sub

        Bon après midi
        Michel
        1. HAXitoo Auteur
          Non, alors je prends tout les avis...malheureusement j'ai une erreur: 

          Derlig = .Columns("D").Find("*", , , , , xlPrevious).Row
          'L'indice n'appartient pas à la sélection.
        2. HAXitoo Auteur
          La formule de pijaku fonctionne très bien. Je vais essayer de me focaliser sur ce code. Il faut juste que je l'adapte encore à mes besoins. Qui est de l'étendre sur d'autre colonne.
        3. michel_m Contributeur
          Le code était testé et marchait : je viens de re-tester: la dernière ligne dans informations est 52

          L'explication est que tu ne veux rien savoir et que tu ne sais pas merci pour le temps passé !!!

          je t'inscris sur ma blacklist: ras le bol de bosser bénévolement pour des mules
      4. HAXitoo Auteur
        On va dire que le problème initial a été résolu. Merci pour votre aide qui m'a été précieux.
        1. pijaku Modérateur
          Bonjour,

          Avant d'aller plus avant, posons tout d'abord des règles :

          1- expose clairement toute la problématique, de suite. En effet, lorsque le demandeur ajoute des éléments au fur et à mesure, il faut bien souvent repenser tout le code. Travail inutile donc.

          2- Essaie systématiquement tous les tests demandés. Si ça coince explique clairement ou et quel message d'erreur.
          exemple :
          malheureusement j'ai une erreur:
          Derlig = .Columns("D").Find("*", , , , , xlPrevious).Row
          'L'indice n'appartient pas à la sélection.
          Ne suffit pas. En effet, dans le code proposé, on retrouve 2 fois la ligne 
          Derlig = .Columns("D").Find("*", , , , , xlPrevious).Row
          Laquelle coince?

          3- Si tu ne comprends pas un code, ou une partie du code proposé, il faut le dire de suite. On prends le temps d'expliquer. En effet, la maintenance de ton appli sera pour toi, pas pour nous. Si tu ne sais pas comment fonctionne le code, tu es très mal barré.

          Si c'est ok pour toi, on continue.

          Par contre, on va continuer avec le code proposé par Michel_m, s'il le veut bien. En effet, je l'ai testé et :
          1- il fonctionne parfaitement avec ton classeur et tes données,
          2- il est nettement plus rapide que le code que je te proposais (0.007 sec au lieu de 0.328)
          3- il est plus sécuritaire (pas de 
          Application.EnableEvents = False
          )

          Tu dis...
          1. HAXitoo Auteur
            Bon alors le code de michel_m fonctionne bien aujourd'hui. Je devais être fatigué hier et faire une faute. Alors je suis d'accord avec toi et j'essayerai d'être plus clair et précis lorsque j'expose un de mes problèmes.

            1 - Le message initial de ce post a été résolu. J'ai effectivement obtenu ce que je désirais et je vous en remercie. Maintenant, je souhaite faire le même processus pour les colonnes C, E et G de la feuille 2 (Statistiques). Donc vérifier si dans la feuille 1 (Informations) les valeurs correspondent à la feuille 5 (Base de données) et les copier dans la feuille 2 (Statistiques) si tel est le cas.

            2 - J'essaie systématiquement ce que vous me proposé, mais à un espace ou . près ça peut bloquer, alors je ne le vois pas tout de suite donc ça me prend du temps à chercher. L'erreur de hier, n'est plus aujourd'hui, ce que je comprends même pas alors que j'ai juste fais un copier/coller de hier. Enfin bref...

            3 - Je fais ce qu'on appelle du bricolage. J'ai de la facilité pour tout ce qui est de la logique, mais mon vocabulaire du langage VBA est à 0. Donc par déduction je peux comprendre le code, mais j'en ai aucune idée de ce que ça fait réellement. Pour "imager" mon niveau, je n'ai aucune idée de ce que signifie les Dim ... As String ou autre, mais je sais que je dois les faire.

            4 - Pour moi c'est ok, on peut continuer avec le code de michel_m.
          2. pijaku Modérateur
            Bon on va reprendre pas à pas, comme cela tu feras l'adaptation toi-même pour les autres colonnes. Du moins, on va essayer.
            Le code de Michel_m commence ainsi : 
            Option Explicit

Private Sub Worksheet_Activate()
Dim Derlig As Integer, Cptr As Integer, T_info(), T_base()
Dim D_info As Object, D_base As Object
Dim Lig As Integer, T_stats()


            - 
            Option Explicit
            = Déclaration obligatoire des variables.
            - 
            Private Sub Worksheet_Activate()
            = Code se déclenchant automatiquement lorsque l'événement Worksheet_Activate est déclenché. Soit lorsque tu clique sur l'onglet de ladite feuille.
            - Dim : sert à déclarer une variable. Une variable est une valeur que l'on stocke dans la mémoire de l'ordinateur.
            - 
            Dim Derlig As Integer, Cptr As Integer,
            = On déclare deux variables (DerLig et Cptr) comme étant des nombres entiers compris entre -32 768 et 32 767. Ici on voit que l'auteur de la macro est malin et qu'il a donc pensé à affubler ces variables de noms simples à identifier. DrLig pour dernière ligne et Cptr pour compteur...
            - 
            Dim Lig As Integer,
            = On déclare une variable comme étant un nombre entier compris entre -32 768 et 32 767. Lig va certainement représenter les lignes dans une boucle...
            - 
            Dim ... ..., T_info(), T_base()
            = On déclare ici deux variables tableaux. Les variables tableaux servent à stocker, non pas une valeur, mais une multitude de valeurs dans la mémoire de l'ordinateur.
            - 
            Dim D_info As Object, D_base As Object
            = On déclare ici deux variables Object. Tu as dit vouloir ôter les doublons. Pour cela, Michel utilise des objets dictionary, que l'on déclare comme cela.
            - 
            Dim ... ..., T_stats()
            = Déclaration d'une troisième variable tableau.

            Tutoriels :
            - Les variables (by silkyroad)
            - Les variables tableaux (by silkyroad)
            - Les variables tableaux (by Boisgontier)
            - L'objet Dictionary (by Boisgontier)
          3. HAXitoo Auteur
            Okay, alors je vais essayé les tutos de mon côté pour voir si je serai capable de faire quelquechose tout seul.

            Par contre je viens de voir que dans la feuille "Statistiques" il manque une valeur. J'ai regardé dans le code, je n'ai pas réussi à trouver d'où ça pouvais venir. Dans la feuille 1 "Informations" on retrouve 8 fonctions et dans la feuille 2 "Statistiques" on en retrouve que 7.
          4. pijaku Modérateur
            Oui, en effet, il y a deux petites modifications à faire dans la fin du code. 

              '--------restitution des fonctions existantes dans la base feuille stats
  ReDim T_stats(UBound(T_info))
  For Cptr = 0 To UBound(T_info) '--------ICI on doit commencer la boucle à 0
    If D_base.exists(T_info(Cptr)) Then
          T_stats(Lig) = T_info(Cptr)
          Lig = Lig + 1
     End If
  Next
  With Sheets("Statistiques")
     .Range("A5:A2000").ClearContents
     .Range("A5").Resize(UBound(T_info) + 1, 1) = Application.Transpose(T_stats) 'ICI ajouter +1 à UBound(T_Info)
  End With
  'pour essai rapidité
  Application.ScreenUpdating = True
  MsgBox "liste effectuée en " & Timer - start & " sec."
          5. HAXitoo Auteur
            Bonjour,

            Désolé pour cette réponse tardive, ce matin je n'arriverais pas à être là. Je vais essayer de venir cet après-midi.
        2. HAXitoo Auteur
          Voilà, je suis de retour =)

          J'ai pu faire la correction. Mais pourquoi avons nous dû commencer la boucle à 0 ? Qu'est-ce que ça signifie concrètement ?
          1. pijaku Modérateur
            Toi, tu n'as pas lu le tutoriel sur les variables tableaux...
            C'est expliqué ICI.
          2. HAXitoo Auteur
            Je vais lire ça de suite, j'avais complètement oublié !
          3. HAXitoo Auteur
            Ok, alors ma question est : Etait-on obligé de créer un tableau pour faire ce que je voulais ? (Je ne connais pas du tout les possibilités et limites de VBA) Si tu regardes le code que j'ai pu faire dans par exemple la feuille 4 "Attestation", n'y avait-il pas un moyen de faire de la même manière ? Ou bien était-je à côté de la plaque ?
          4. pijaku Modérateur
            Non tu n'étais pas à côté de la plaque.
            Mais...
            La méthode donnée par Michel utilisant une variable tableau est :
            - plus rapide,
            - plus fiable
            - adaptée à un classeur évolutif.

            Ta méthode fonctionne bien avec une cinquantaine de lignes. Si ton classeur évolue et que tu gères, à terme, un millier de lignes, les variables tableaux sont la solution adéquate...
          5. HAXitoo Auteur
            Je vois, je pense qu'on peut continuer alors =)

            Si maintenant, je veux faire la même chose pour les autres colonnes, à savoir, C, E et G de la feuille 2 "Statistiques", dois-je créer, dans le code, de nouveaux tableau ou est-il possible, en quelque sorte, d'agrandir le tableau que michel_m a fait pour la colonne A ? (Je sais toujours pas si ce que je dis est clair ou pas xD)
        3. HAXitoo Auteur
          J'ai fais ça, je pense que tu as raison, je devrais renommer les tableaux. 

          Private Sub Worksheet_Activate()

          Dim Derlig As Integer, Cptr As Integer, T_info(), T_base()
          Dim Derlig2 As Integer, Cptr2 As Integer, T_info2(), T_base2()
          Dim D_info As Object, D_base As Object
          Dim D_info2 As Object, D_base2 As Object
          Dim Lig As Integer, T_stats()
          Dim Lig2 As Integer, T_stats2()
          'pour essai rapidité
          Dim Start As Single
          Start = Timer

          Application.ScreenUpdating = False

          '--------liste des FONCTIONS feuille info sans doublons
          With Sheets("Informations")
          'mémorisation fonctions
              Derlig = .Columns("D").Find("*", , , , , xlPrevious).Row
              T_info = Application.Transpose(.Range("D5:D" & Derlig).Value)
          'création liste fonctions sans doublons
              Set D_info = CreateObject("scripting.dictionary")
              For Cptr = 1 To UBound(T_info)
                  If Not D_info.exists(T_info(Cptr)) Then D_info.Add T_info(Cptr), ""
              Next
              T_info = D_info.keys
          End With

          '--------liste des FORMATIONS feuille info sans doublons
          With Sheets("Informations")
          'mémorisation fonctions
              Derlig2 = .Columns("H").Find("*", , , , , xlPrevious).Row
              T_info2 = Application.Transpose(.Range("H5:H" & Derlig2).Value)
          'création liste fonctions sans doublons
              Set D_info2 = CreateObject("scripting.dictionary")
              For Cptr2 = 1 To UBound(T_info2)
                  If Not D_info2.exists(T_info2(Cptr2)) Then D_info2.Add T_info2(Cptr2), ""
              Next
              T_info2 = D_info2.keys
          End With

          '--------liste des FONCTIONS feuille base
          With Sheets("Base de données")
          'mémorisation fonctions
              Derlig = .Columns("D").Find("*", , , , , xlPrevious).Row
              T_base = Application.Transpose(.Range("D5:D" & Derlig).Value)
          'création liste fonctions
              Set D_base = CreateObject("scripting.dictionary")
              For Cptr = 1 To UBound(T_base)
                  D_base.Add T_base(Cptr), ""
              
              Next
              
          End With

          '--------liste des FORMATIONS feuille base
          With Sheets("Base de données")
          'mémorisation fonctions
              Derlig2 = .Columns("E").Find("*", , , , , xlPrevious).Row
              T_base2 = Application.Transpose(.Range("E5:E" & Derlig2).Value)
          'création liste fonctions
              Set D_base2 = CreateObject("scripting.dictionary")
              For Cptr2 = 1 To UBound(T_base2)
                  D_base2.Add T_base2(Cptr2), ""
              
              Next
              
          End With

          '--------restitution des FONCTIONS existantes dans la base feuille stats
          ReDim T_stats(UBound(T_info))
          For Cptr = 0 To UBound(T_info)
              If D_base.exists(T_info(Cptr)) Then
                  T_stats(Lig) = T_info(Cptr)
                  Lig = Lig + 1
              End If
          Next

          With Sheets("Statistiques")
                  .Range("A5:A2000").ClearContents
                  .Range("A5").Resize(UBound(T_info) + 1, 1) = Application.Transpose(T_stats)
          End With

          '--------restitution des FORMATIONS existantes dans la base feuille stats
          ReDim T_stats2(UBound(T_info2))
          For Cptr2 = 0 To UBound(T_info2)
              If D_base2.exists(T_info2(Cptr2)) Then
                  T_stats2(Lig2) = T_info2(Cptr2)
                  Lig2 = Lig2 + 1
              End If
          Next

          With Sheets("Statistiques")
                  .Range("C5:C2000").ClearContents
                  .Range("C5").Resize(UBound(T_info2) + 1, 1) = Application.Transpose(T_stats2)
          End With

          'pour essai rapidité
              Application.ScreenUpdating = True

          End Sub
          1. HAXitoo Auteur
            J'en profite pour poser une question : Derlig, Lig, Cptr, c'est quelque chose de spécifique à ce qu'on fait ou bien on peut écrire ce qu'on veut?
          2. pijaku Modérateur
            Ce n'est pas spécifique. Ce ne sont que des variables, tu peux décider de leur nom...
          3. HAXitoo Auteur
            Ok, je pensais que c'était une question stupide alors j'ai effacé xD
          4. pijaku Modérateur
            Message restauré...
          5. HAXitoo Auteur
            Je continue avec cette façon de faire pour les deux autres tableaux ? En ayant renommer les tableaux ? 

            Dim Derlig_fonction As Integer, Cptr_fonction As Integer, T_info_fonction(), T_base_fonction()
            Dim Derlig_formation As Integer, Cptr_formation As Integer, T_info_formation(), T_base_formation()
            Dim Derlig_intervenant As Integer, Cptr_intervenant As Integer, T_info_intervenant(), T_base_intervenant()
            Dim Derlig_service As Integer, Cptr_service As Integer, T_info_service(), T_base_service()
            Dim D_info_fonction As Object, D_base_fonction As Object
            Dim D_info_formation As Object, D_base_formation As Object
            Dim D_info_intervenant As Object, D_base_intervenant As Object
            Dim D_info_service As Object, D_base_service As Object
            Dim Lig_fonction As Integer, T_stats_fonction()
            Dim Lig_formation As Integer, T_stats_formation()
            Dim Lig_intervenant As Integer, T_stats_intervenant()
            Dim Lig_service As Integer, T_stats_service()
        4. HAXitoo Auteur
          Je t'ai envoyé en MP ma version du fichier, car j'aurais encore deux bugs à corriger.

          Dans la feuille 2 "Statistiques" dans la colonne F il y a une formule (le résultat affiché est juste) que Excel dit qu'elle est incohérente.

          =SI(E5<>"";SOMMEPROD((Informations!$I$5:$L$1798=E5)*(Informations!$Q$5:$Q$1798-Informations!$P$5:$P$1798))/NB.SI(Informations!$I$5:$L$1798;E5);"")

          Ensuite dans la feuille 4 "Attestation" dans la colonne J, je ne comprends pas pourquoi certaines cellules n'affiche pas le résultat.
          1. HAXitoo Auteur
            Alors j'ai pu résoudre le premier problème.
          2. pijaku Modérateur
            Et je ne comprends pas ta formule en colonne J feuille attestation...
          3. HAXitoo Auteur
            Elle était sensé me donner le nombre d'heure de la formation qui s'affiche en colonne D
          4. pijaku Modérateur
            Essaye celle ci :
            =SI(D5<>"";RECHERCHEV(D5;Informations!H5:Q1798;10;FAUX)-RECHERCHEV(D5;Informations!H5:Q1798;9;FAUX);"")
          5. HAXitoo Auteur
            Merci beaoucp, ça fonctionne =) Mais je comprends pas xD

            Pourquoi : H5:Q1798 ? Que signifie le 10 ou le 9 entre les ; ; ?

        Discussions similaires

        Copier un lien instagram
        alaurore

        7 réponses
        Retrouver liens copiés sur le téléphone
        SAMA

        2 réponses
        copie d'un lien dans le navigateur internet
        Ulysse Orseau

        4 réponses
        Téléphone en condition optimale...?
        Elka_3079

        2 réponses
        enlever mode sécurisé huawei
        faihere26

        1 réponse