Centralisation de données

[Joda]

Bonjour à tous,

je me casse les dents sur une problématique et je viens demander un peu d'aide (ou une autre façon d'aborder le problème...)
J'ai un fichier qui recense dans un onglet des données. (les clients de la société).
Ce fichier va être transmis à plusieurs personnes qui vont l'utiliser, le modifier et l'étoffer.
J'aimerais créer une macro permettant de faire la mise à jour de ces données.
En effet, il y aurait un tableau maître qui aurait toutes les données à jour.

Voilà comment j'imagine la chose :

Il existe 2 types de modifs : modif de ligne existante et création de ligne
Si pas de modif, les données restent telles qu'elles sont dans le tableau maitre
Si modif de ligne existante, la ligne est modifiée au même index dans le tableau maitre
Si création de ligne, implémentation de la nouvelle ligne

Et ce pour chaque tableaux "fils" récupérés...
J'ajoute que chacune de mes lignes commence par un numéro (numéro de client) qui s'incrémente de 1 à ....

Je passe par une étape intermédiaire qui m'affiche, dans un onglet dans le tableau maitre, les nouvelles lignes du tableau fils

Application.ScreenUpdating = False
  Set f1 = Sheets("Tableau_maitre")
  Set f2 = Sheets("Tableau_fils")
  a = f1.Range("A1").CurrentRegion.Value
  b = f2.Range("A1").CurrentRegion.Value
  Set mondico1 = CreateObject("Scripting.Dictionary")
  For j = 2 To UBound(a)
    mondico1(a(j, 1)) = ""
  Next j
  ligne = 1
  Dim c
  ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To UBound(a, 2) + 1)
  For j = 2 To UBound(b)
    temp = ""
    For K = 1 To UBound(b, 2): temp = temp & b(j, K): Next K
    If Not mondico1.Exists(b(j, 1)) Then
      For K = 1 To UBound(b, 2): c(ligne, K) = b(j, K): Next K
      c(ligne, K) = j
      ligne = ligne + 1
    End If
  Next
  Sheets("Nouvelles_lignes").[a2].Resize(UBound(a, 1), UBound(a, 2) + 1) = c

  Next

Je copie les données du tableau fils dans un onglet appelé "Tableau_fils", je compare aux données du "tableau_maitre" et j'écris les nouvelles lignes dans "Nouvelles_lignes"

Je bute un peu plus sur le code pour les lignes avec le même numéro initial mais avec une modif dans une des colonnes ...

Application.ScreenUpdating = False
  Set f1 = Sheets("Tableau_maitre")
  Set f2 = Sheets("Tableau_fils")
  Set f3 = Sheets("Lignes_modif")
  f3.[A2:O1000].ClearContents
  f3.[A2:O1000].Interior.ColorIndex = xlNone
  a = f1.Range("A1").CurrentRegion.Value
  b = f2.Range("A1").CurrentRegion.Value
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For i = 2 To UBound(a)
    mondico2(a(i, 1)) = ""
  Next i
  ligne = 2
  For i = 2 To UBound(b)
    temp = ""
    For K = 1 To UBound(b, 2): temp = temp & b(i, K): Next K
    If mondico2.Exists(b(i, 1)) Then
      Set temp = f1.Columns(1).Find(b(i, 1))
      For K = 1 To UBound(b, 2)
         f3.Cells(ligne, K) = b(i, K)
         If b(i, K) <> temp.Offset(, K - 1) Then f3.Cells(ligne, K).Interior.ColorIndex = 6
      Next K
      f3.Cells(ligne, K) = i
      ligne = ligne + 1
    End If

Ces 2 codes sont tirés de Doublons

Ce dernier code marche pour une modif mais dès que j'ai plus d'une ligne modifiées, il ne fonctionne pas.
Il est censé me renvoyer la ligne complète avec en surligné jaune les valeurs modifiées.
Cela permet à l'opérateur final de voir en un coup d'oeil les modifs et de les approuvées ou non.

J'envisage par la suite une autre macro qui va prendre toutes ces lignes (nouvelles et modifiées&validées) et les inscrire dans le tableau maitre.



Bien, j'en ai fini avec les explications (un peu laborieuses).
Je suis à l'écoute pour clarifier vos questions si besoins

Je vous remercie de votre aide

 

[Staple1600]

Re : Centralisation de données

Bonsoir à tous

Joda [highlight][Bienvenue sur le forum][/code]

Je suis à l'écoute pour clarifier vos questions si besoins

Clarifions avec la Question 😉
Pourquoi n'as tu pas lu charte du forum et ce point en particulier ?

5 – La possibilité de joindre des fichiers est donnée sur ce forum. Ne pas hésiter à utiliser cette fonction, tout en veillant que les données soient bidons et donc qu’aucune donnée confidentielle, nominative ne soit dans le fichier.

(PS: je n'évoque pas le préambule qui s'affiche quand on crée une discussion que tu as sans doute purement ignoré 🙄)

 

[Speel]

Re : Centralisation de données

Bonsoir,

Dans ce genre là ?

 

[Joda]

Re : Centralisation de données

Merci pour vos messages !

Speel : je teste le code avec mon application. Je regarde notamment si je fais plusieurs modifs si les lignes ne se mélangent pas...
Staple1600 : je n'avais pas pris le temps de rendre mon fichier diffusable. Je le mets maintenant en piece jointe.

 

[Joda]

Re : Centralisation de données

Les valeurs maitres sont dans "Tableau"
Les valeurs nouvelles sont dans "BD1" et c'est cet onglet que je voudrais comparer a l'onglet "Tableau".
Je suis passé par la création de 2 onglets : les nouvelles lignes et les lignes existantes mais qui ont été modifiées.

 

[klin89]

Re : Centralisation de données

Bonsoir le forum,

Pour plus de clarté, je n'ai gardé que les 7 premières colonnes de tes 2 tableaux.
En feuil1, j'ai placé tes 2 tables côte à côte.
Pour la comparaison, résultat en feuil2 :

Option Explicit

Sub Essai()
Dim a, i As Long, j As Integer, t As Integer
Dim n As Integer, txt As String, e, x
    Application.ScreenUpdating = False
    a = Sheets("Feuil1").Range("a1").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            For t = 1 To UBound(a, 2) Step 7
                x = Application.RoundDown(t / 7, 0) + 1
                txt = Join$(Array(a(i, t), a(i, t + 1), a(i, t + 2), a(i, t + 3), a(i, t + 4), a(i, t + 5), a(i, t + 6)), Chr(2))
                If Not .exists(txt) Then
                    ReDim w(1 To UBound(a, 2) + UBound(a, 2) / 2, 1 To 1)
                Else
                    w = .Item(txt)
                End If
                w(UBound(a, 2) + x, 1) = w(UBound(a, 2) + x, 1) + 1
                If w(UBound(a, 2) + x, 1) > UBound(w, 2) Then
                    ReDim Preserve w(1 To UBound(w, 1), 1 To w(UBound(a, 2) + x, 1))
                End If
                For j = t To t + 6
                    w(j, w(UBound(a, 2) + x, 1)) = a(i, j)
                Next
                .Item(txt) = w
            Next
        Next
        n = 2
        Sheets("Feuil2").UsedRange.Clear
        For Each e In .keys
            w = .Item(e)
            Sheets("Feuil2").Cells(n, 1).Resize(UBound(w, 2), UBound(a, 2)).Value = _
            Application.Transpose(w)
            n = n + UBound(w, 2)
        Next
    End With
    'Mise en forme
    With Sheets("Feuil2")
        .Cells(1).Resize(, 7).Interior.ColorIndex = 19
        .Cells(8).Resize(, 7).Interior.ColorIndex = 35
        For i = 1 To 8 Step 7
            .Cells(i).Resize(, 7).Value = Array("Num essai", "Marché", "Usage", "Pays", "région", "Resp.Commercial", "Resp.Projet")
        Next
    End With
    With Sheets("Feuil2").Cells(1).CurrentRegion
        .Columns.AutoFit
        .Rows.RowHeight = 19.5
        .Font.Name = "calibri"
        .NumberFormat = "@"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders.Weight = 2
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Rows(1).Borders(xlEdgeBottom).Weight = 2
    End With
    Sheets("Feuil2").Activate
    Application.ScreenUpdating = True
End Sub

A tester dans ton fichier original.
Il faudra changer le code ci-dessous :
Calqué sur 7 colonnes

For t = 1 To UBound(a, 2) Step 7
   x = Application.RoundDown(t / 7, 0) + 1
   txt = Join$(Array(a(i, t), a(i, t + 1), a(i, t + 2), a(i, t + 3), a(i, t + 4), a(i, t + 5), a(i, t + 6)), Chr(2))

For j = t To t + 6
   w(j, w(UBound(a, 2) + x, 1)) = a(i, j)
Next

Et revoir la mise en forme évidemmment.
Edit : comparer 2 tables de 31 colonnes côte à côte, pas simple visuellement, mais bon tu peux masquer certaines colonnes.
Résumé : au final, je ne garde que la partie verte du tableau affiché en feuil2 tout en supprimant les lignes vides de cette partie

 

[Joda]

Re : Centralisation de données

Merci beaucoup pour cette proposition.
En voyant vos solutions, je me rends compte que je me suis attelé à quelquechose qui dépasse mes connaissances 🙂 Du coup, je vais devoir me plonger dans la théorie afin de comprendre le code car je n'aime pas copier/coller betement !
Merci encore pour vous être penchés sur le sujet !

 

[klin89]

Re : Centralisation de données

Bonjour Joda,

J'ai rajouté une condition, c'est mieux ainsi.

Option Explicit

Sub Essai()
Dim a, i As Long, j As Integer, t As Integer
Dim n As Integer, txt As String, e, x
    Application.ScreenUpdating = False
    a = Sheets("Feuil1").Range("a1").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            For t = 1 To UBound(a, 2) Step 7
                x = Application.RoundDown(t / 7, 0) + 1
                txt = Join$(Array(a(i, t), a(i, t + 1), a(i, t + 2), a(i, t + 3), a(i, t + 4), a(i, t + 5), a(i, t + 6)), Chr(2))
                If Len(txt) > 6 Then
                    If Not .exists(txt) Then
                        ReDim w(1 To UBound(a, 2) + UBound(a, 2) / 2, 1 To 1)
                    Else
                        w = .Item(txt)
                    End If
                    w(UBound(a, 2) + x, 1) = w(UBound(a, 2) + x, 1) + 1
                    If w(UBound(a, 2) + x, 1) > UBound(w, 2) Then
                        ReDim Preserve w(1 To UBound(w, 1), 1 To w(UBound(a, 2) + x, 1))
                    End If
                    For j = t To t + 6
                        w(j, w(UBound(a, 2) + x, 1)) = a(i, j)
                    Next
                    .Item(txt) = w
                End If
            Next
        Next
        n = 2
        Sheets("Feuil2").UsedRange.Clear
        For Each e In .keys
            w = .Item(e)
            Sheets("Feuil2").Cells(n, 1).Resize(UBound(w, 2), UBound(a, 2)).Value = _
            Application.Transpose(w)
            n = n + UBound(w, 2)
        Next
    End With
    'Mise en forme
    With Sheets("Feuil2")
        .Cells(1).Resize(, 7).Interior.ColorIndex = 19
        .Cells(8).Resize(, 7).Interior.ColorIndex = 35
        For i = 1 To 8 Step 7
            .Cells(i).Resize(, 7).Value = Array("Num essai", "Marché", "Usage", "Pays", "région", "Resp.Commercial", "Resp.Projet")
        Next
    End With
    With Sheets("Feuil2").Cells(1).CurrentRegion
        .Columns.AutoFit
        .Rows.RowHeight = 19.5
        .Font.Name = "calibri"
        .NumberFormat = "@"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders.Weight = 2
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Rows(1).Borders(xlEdgeBottom).Weight = 2
    End With
    Sheets("Feuil2").Activate
    Application.ScreenUpdating = True
End Sub

Dis nous au moins si cela répond à la question initiale.

Klin89

 

[Joda]

Re : Centralisation de données

Merci pour cette modification.

Oui cela répond au besoin puisque les lignes modifiées ressortent et ensuite je vais pouvoir les récupérer et les réintégrer dans mon tableau.

Comme je te l'ai dit, c'est au niveau de la compréhension de ce code que je dois travailler 🙂

Je reviens si j'ai des questions ! Merci encore !

Pour ma gouverne, est-ce une problématique (le consolidation de données) qui se règle de cette façon ou bien y a t'il un mode complètement différent de faire ce travail ?
Car dès le début, je suis parti la dessus mais comme ceux qui ont dl le fichier excel, ca s'apparente plus a du bricolage qu'autre chose ! Les codeurs ont du avoir des boutons !

 

[klin89]

Re : Centralisation de données

Re Joda,

Effectivement, une autre façon de faire dans le lien ci-dessous.
https://www.excel-downloads.com/threads/macro-pour-supprimer-des-lignes-en-doublon.209557/

Reprends les 2 macros de J-Boisgontier
Places tes 2 tables l'une en dessous de l'autre.
La jaune en dessous de la verte dans mon exemple.
Tu exécutes la macro SupDoublonsToutesCol() puis SupDoublonsColA() dans cet ordre.
Tu obtiendras le résultat souhaité.
Noublies pas de modifier le nom des feuilles dans les macros.

Klin89