Coordonner des tableaux ensembles

Bonjour à tous,

Je vous joint deux tableaux. Dans celui en couleur, j'introduis les renseignements demandés. Dans le tableau complet, les renseignements doivent s'inscrire dedans. Au début, je faisais, égal la cellule mais cela prends du temps car j'ai plusieurs tableaux de couleur qui reprennent des blocs de logement. Il faudrait que je trouve le moyen, que quand j'écris dans le 1er tableau, tout s'inscrit dans le suivant et biensûr, qu'il fasse des updates car je ne suis pas obligé de l'ouvrir à chaque fois... attention, vous verrez que le premier tableau les colonnes se suivent en-dessous et dans l'autre c'est le contraire, elles se suivent en ligne......

merci d'avance

Patoche0495

Bonjour,

Voir pièces jointes

A+

Merci,

Mais je crois que tu as fait l'inverse.... Le tableau avec les couleur est le tableau à remplir et il doit se mettre automatiquement dans l'autre mais ça doit être la même formule ?????

merci

Non, ce n'est pas du tout la même formule. (En fait il n'existe guère de formule dans ce cas)

Excel n'est pas fait pour fonctionner comme ça.

A+

bonjour à vous

salut galopin01,

même avis que toi

il vaut mieux saisir directement dans Listingcomplet (c'est un vrai tableau Excel)

Et virer les 12 "tableaux en couleur".

Ensuite, on peut envisager des vues de synthèses (grâce aux tris, filtres).

On part de 13 fichiers, on n'en garde qu'1.

Excel est magique !

Bonjour jmd et galopin,

En fait j'ai absolument besoin de tous les tableaux de couleur. Les tableaux de couleurs génèrent d'autres documents à part, quand j'inscrit les renseignements, ils s'inscrivent sur des documents d'inscriptions (je ne peux vous expliquer plus) et le tableau listing complet n'est qu'un tableau qui reprend tout pour avoir une vue directe sur tous les blocs de logement et qui loge etc........j'ai 10 blocs comme cela avec x chambres....

Je sais que le tableau complet est plus simple et en plus tu sais faire des tris..

Je ferais comme avant "égal cellule" partout....

merci à vous deux.....

Oui c'est à peu près la seule solution. dans ces conditions.

Désolé.

patoche0495 a écrit :

Les tableaux de couleurs génèrent d'autres documents à part, quand j'inscrit les renseignements, ils s'inscrivent sur des documents d'inscriptions

tu peux tout aussi facilement (plus facilement même) créer/éditer des documents à partir d'un tableau unique.

il semble que c'est la base de tout travail en gestion de données/d'informations.

Bonsoir à tous,

Tes 2 feuilles dans le même classeur.

Feuille"F 69", attention au contenu de la cellule "H2" dont la comparaison doit s'effectuer avec les cellules de la colonne C de la feuille "Listing complet"

Idem pour le contenu du champ "adresse" qui n'est pas identique

A tester :

Option Explicit
Sub test()
Dim a, i As Long, j As Long, k As Long, numBloc As String
Dim myAreas As Areas, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.Comparemode = 1
    With Sheets("F 69")
        numBloc = .Range("h2").Value
        Set dico(numBloc) = CreateObject("Scripting.Dictionary")
        Set myAreas = .Columns(2).SpecialCells(2).Areas
        For k = 1 To myAreas.Count
            a = myAreas(k).CurrentRegion
            For j = 2 To UBound(a, 2)
                Set dico(numBloc)(a(1, j)) = CreateObject("Scripting.Dictionary")
                dico(numBloc)(a(1, j)).Comparemode = 1
                For i = 2 To UBound(a, 1)
                    dico(numBloc)(a(1, j))(a(i, 1)) = a(i, j)
                Next
            Next
        Next
    End With
    Application.ScreenUpdating = False
    With Sheets("Listing complet")
        With .Range("b4").CurrentRegion
            With .Offset(1, 3).Resize(.Rows.Count - 1, .Columns.Count - 3)
                .ClearContents
            End With
            For i = 2 To .Rows.Count
                If dico.exists(.Cells(i, 2).Value) Then
                    If dico(.Cells(i, 2).Value).exists(.Cells(i, 3).Value) Then
                        .Cells(i, 4).Resize(, dico(.Cells(i, 2).Value).Item(.Cells(i, 3).Value).Count).Value = _
                            dico(.Cells(i, 2).Value).Item(.Cells(i, 3).Value).items
                    End If
                End If
            Next
        End With
    End With
    Set myAreas = Nothing
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour Klin,

Merci, je vais essayer, mais avec ton module, que dois-je mettre comme formule ??

merci

Re patoche0495,

Le code pour traiter tous tes tableaux

1 feuille = 1 tableau

Option Explicit
Sub test1()
Dim a, i As Long, j As Long, k As Long, numBloc As String
Dim myAreas As Areas, dico As Object, ws As Worksheet
    Set dico = CreateObject("Scripting.Dictionary")
    dico.Comparemode = 1
    For Each ws In Worksheets
        If ws.Name <> "Listing complet" Then
            numBloc = ws.Range("h2").Value
            Set dico(numBloc) = CreateObject("Scripting.Dictionary")
            On Error Resume Next
            Set myAreas = ws.Columns(2).SpecialCells(2).Areas
            On Error GoTo 0
            If Not myAreas Is Nothing Then
                For k = 1 To myAreas.Count
                    a = myAreas(k).CurrentRegion
                    For j = 2 To UBound(a, 2)
                        Set dico(numBloc)(a(1, j)) = CreateObject("Scripting.Dictionary")
                        dico(numBloc)(a(1, j)).Comparemode = 1
                        For i = 2 To UBound(a, 1)
                            dico(numBloc)(a(1, j))(a(i, 1)) = a(i, j)
                        Next
                    Next
                Next
            End If
        End If
        Set myAreas = Nothing
    Next ws
    Application.ScreenUpdating = False
    With Sheets("Listing complet")
        With .Range("b4").CurrentRegion
            With .Offset(1, 3).Resize(.Rows.Count - 1, .Columns.Count - 3)
                .ClearContents
            End With
            For i = 2 To .Rows.Count
                If dico.exists(.Cells(i, 2).Value) Then
                    If dico(.Cells(i, 2).Value).exists(.Cells(i, 3).Value) Then
                        .Cells(i, 4).Resize(, dico(.Cells(i, 2).Value).Item(.Cells(i, 3).Value).Count).Value = _
                        dico(.Cells(i, 2).Value).Item(.Cells(i, 3).Value).items
                    End If
                End If
            Next
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonsoir Klin et merci.

Si je comprends je copier et coller ce module dans le VBA .... Et la formule à mettre dans les cellules ??????

Merci