Recherche entres onglets

[phil87]

Bonjour le Forum,

Je souhaiterai arriver a faire afficher automatiquement dans les différents onglets une croix afin d'éviter de la retaper d'année en année. peut être avec une formule de rechercheV????????
merci par avance.
Cordialement

 

[JHA]

Bonjour à tous,

Un début de piste pour la colonne "Mariage /Pacs"

JHA

 

[cathodique]

Bonsoir,

un essai. La macro complète toutes les feuilles du classeur à partir de la feuille 2014.

Pour exécuter la macro touche-----> Ctrl+t (lettre t).

 

[klin89]

Bonsoir à tous,

Pour le fun, sans formule

Option Explicit
Sub test()
Dim i As Long, j As Long, e, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("2014").Range("a1").CurrentRegion
        For i = 2 To .Rows.Count
            Set dico(.Cells(i, 1).Value) = CreateObject("Scripting.Dictionary")
            dico(.Cells(i, 1).Value).CompareMode = 1
            For j = 2 To .Columns.Count
                If .Cells(i, j).Value <> "" Then
                    dico(.Cells(i, 1).Value)(.Cells(1, j).Value) = .Cells(i, j).Value
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = False
    For Each e In Array("2015", "2016", "2017")
        With Sheets(e)
            With .Range("a1").CurrentRegion
                With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
                    .ClearContents
                End With
                For i = 2 To .Rows.Count
                    If dico.exists(.Cells(i, 1).Value) Then
                        For j = 2 To .Columns.Count
                            If dico(.Cells(i, 1).Value).exists(.Cells(1, j).Value) Then
                                .Cells(i, j).Value = dico.Item(.Cells(i, 1).Value)(.Cells(1, j).Value)
                            End If
                        Next
                    End If
                Next
            End With
        End With
    Next
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

 

[klin89]

Re

Plus simple puisque que l'on retrouve des en-têtes identiques dans chaque feuille

Option Explicit
Sub test()
Dim a, i As Long, j As Long, e, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.Comparemode = 1
    With Sheets("2014").Range("a1").CurrentRegion
        a = .Value
        For i = 2 To UBound(a, 1)
            Set dico(a(i, 1)) = CreateObject("Scripting.Dictionary")
            dico(a(i, 1)).Comparemode = 1
            For j = 2 To UBound(a, 2)
                dico(a(i, 1))(a(1, j)) = a(i, j)
            Next
        Next
    End With
    Application.ScreenUpdating = False
    For Each e In Array("2015", "2016", "2017")
        With Sheets(e)
            With .Range("a1").CurrentRegion
                With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
                    .ClearContents
                End With
                For i = 2 To .Rows.Count
                    If dico.exists(.Cells(i, 1).Value) Then
                        .Cells(i, 2).Resize(, dico(.Cells(i, 1).Value).Count).Value = _
                        dico(.Cells(i, 1).Value).items
                    End If
                Next
            End With
        End With
    Next
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

 

[cathodique]

Bonsoir Klin89,

Tu manipules fort bien Les dictionnaires.

j'ai omis une chose très importante avant de proposer un code, je n'ai pas vérifié la position des noms sur les différentes feuilles. Je suis partie sur fausse base.

Je voudrais stp que tu m'éclaires un peu sur ton code.
Je devine un peu mais pas sûr, que veux dire ces 2 lignes de codes

 Set dico(.Cells(i, 1).Value) = CreateObject("Scripting.Dictionary")
            dico(.Cells(i, 1).Value).CompareMode = 1

et pourquoi il y a en ligne 3: dico.CompareMode = 1, n'y a-t-il pas répétition?

D'après ce que j'ai pu comprendre notre ami cherche à compléter les feuilles 2015, 2016 et 2017 à partir de la feuille 2014 (pour ne pas repointer les mariés).

Sauf erreur de ma part, le code vide les feuilles avant de réinjecter les données.
à moins que ton code aie mémorisé les données de ces feuilles préalablement.

Merci par avance pour tes explications.

Bonne soirée.

edit: nos messages se sont croisés.

 

[klin89]

Bonsoir cathodique,

Pour simplifier encore, on pourrait l'écrire comme ci-dessous :
puisque les 3 feuilles cibles contiennent le même nombre de colonnes rangées dans un ordre identique à celui de la feuille source
Donc un dictionnaire principal suffit contrairement aux 2 exemples précédents.

Option Explicit
Sub test()
Dim a, i As Long, j As Long, e, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("2014").Range("a1").CurrentRegion
        a = .Value
        For i = 2 To UBound(a, 1)
            'l'item associé à la clé est un tableau à 1 dimension, l'indice commençant à 0
            'on utilise la fonction array pour fixer les 8 éléments retenus (0 à 7)
            'pour ajouter la clé et associer son élément,
            'on emploie la propriété Item du dictionnaire
            dico.Item(a(i, 1)) = Array(a(i, 2), a(i, 3), a(i, 4), a(i, 5), _
                                       a(i, 6), a(i, 7), a(i, 8), a(i, 9))
        Next
    End With
    Application.ScreenUpdating = False
    For Each e In Array("2015", "2016", "2017")
        With Sheets(e)
            With .Range("a1").CurrentRegion
                With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
                    .ClearContents
                End With
                For i = 2 To .Rows.Count
                    'si la clé existe
                    If dico.exists(.Cells(i, 1).Value) Then
                        .Cells(i, 2).Resize(, UBound(dico.Item(.Cells(i, 1).Value)) + 1).Value = _
                        dico.Item(.Cells(i, 1).Value)
                    End If
                Next
            End With
        End With
    Next
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

cathodique a dit :

Sauf erreur de ma part, le code vide les feuilles avant de réinjecter les données.

le problème, c'est que le demandeur ne nous dit pas tout
Si tu supprimes dans la feuille source une clé, et que tu gardes cette même clé dans les feuilles cibles,
les données, affichées dans les feuilles cibles, associées à cette clé seront alors conservées si tu ne rajoutes pas ceci :

With .Range("a1").CurrentRegion
    With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
        .ClearContents
    End With

On ne peut pas vraiment parler de mise à jour

Dernier point :
La propriété CompareMode est le mode utilisé pour comparer les clés
Un dictionnaire est sensible à la casse contrairement aux TCD et filtre élaboré (il me semble)
Par défaut CompareMode = 0 c'est à dire que la clé "toto" est différente de "TOTO"
Dans mon exemple "toto" est égal à "TOTO" puisque CompareMode = 1

Pour finir mes explications :

Set dico = CreateObject("Scripting.Dictionary")
dico.Comparemode = 1
----> le mode de comparaison de la clé du dictionnaire parent

Set dico(a(i, 1)) = CreateObject("Scripting.Dictionary")
dico(a(i, 1)).Comparemode = 1
----> le mode de comparaison de la clé du dictionnaire enfant

klin89

 

[cathodique]

Bonjour Klin89

Je te remercie pour tes explications. Je n'ai pas tout compris mais ça viendra un jour, ça viendra!

Très gentil de ta part ce partage.

 

[phil87]

Bonsoir a vous tous
C'est tout a fait ce que je recherchais. Merci encore!!!!!!!!!