XL 2010 faire une copie par comparaison de cellule avec priorité de sens

superbog · 21 Janvier 2017

Bonsoir à tous,

Voilà j'ai deux feuilles excel dans deux classeurs différents (dans deux répertoires différents), ci joint fichiers
J'ai mis (merci Job75) une macro private sub directement sur chaque feuille de sorte que chaque fois qu'une ligne est modifiée, une lettre se mette dans une colonne spéciale de cette feuille

Ensuite je dois comparer les deux feuilles pour pour que les cellules A:Q soient toujours identiques quand A=A, sachant que l'une est prioritaire mais que la macro doit partir de l'autre

explication
prioritaire c'est à dire que les modifs secl priment sur celles de affb
si il y a des modifs sur une ligne dans secl et pas dans affb, alors la ligne doit être copiée de secl à affb
si il y a des modifs sur une ligne dans affb et pas dans secl, alors la ligne doit être copiée de affb à secl
MAIS si il y a des modifs sur une ligne dans secl ET dans affb, alors la ligne doit être copiée de secl à affb, secl étant prioritaire
la macro doit impérativement être lancée à partir de affb car l'utilisateur de secl n'a pas accès à affb (par contre évidemment l'utilisateur de affb a accès à secl

La comparaison se fait par la colonne A des deux fichiers.

Et si un numéro existe dans la colonne A de secl mais pas dans la colonne A de affb alors il faut copie la ligne de secl dans affb en fin de page et trier par colonne A.

Enfin avant de fermer je dois vérifier que dans affb les cellules A:A sont bien identiques aux R:R

Help

Voici ce que j'ai fait (au moins ça, ca marche)

VB:

Sub MAJ_TP()
Dim sh1 As Worksheet, sh2 As Worksheet, y&, i&

Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est ouvert
Workbooks.Open "C:\Users\test\secl.xlsm" 'chemin à adapter
Set sh1 = ThisWorkbook.Sheets("affb")
Set sh2 = Workbooks("secl.xlsm").Sheets("secl")

    For i = 2 To sh2.Range("B300").End(xlUp).Row

          'Copie les valeurs si "M" en colonne R de clients.xlsm
        If (sh2.Cells(i, "R")) = "M" Then
            For y = 2 To sh1.Range("B300").End(xlUp).Row
                      If sh1.Cells(y, "A") = sh2.Cells(i, "A") Then
                      sh1.Cells(y, 2).Resize(, 16) = sh2.Cells(i, 2).Resize(, 16).Value
                      sh1.Cells(y, "AZ") = "M"
                      sh2.Cells(i, "R") = ""
                      End If
             Next y
          
         End If
       
    Next i
 

sh2.Parent.Close True 'facultatif, enregistre et ferme le fichier sh2
sh1.Parent.Save
If IsEmpty(sh1.Range("AZ:AZ")) Then MsgBox "vérification faite, aucune mise à jour base"

MsgBox "base mise à jour et enregistrée"

Application.ScreenUpdating = True

End Sub

merci d'avance de votre aide

Dranreb · 21 Janvier 2017

Bonsoir.
Ça marche mais ça risque de devenir lent, c'est ça ?
Mais une question me taraude: comment sait on qu'il y a des modifs dans affb ?
A t-on une autre feuille de son ancienne situation ?
On peut déterminer si tout est pareil dans affb et et dans secl mais si c'est différent, faut il faire autre chose selon qu'il y a "M" en colonne R ou pas ?
Et si une cellule est vide prendre l'autre, si aucune ne l'est prendre secl ? Qu'il y ait "M" ou pas ?
Je pourrais faire en sorte qu'on puisse avoir l'une derrière l'autre chaque paire de ligne on ligne isolée de secl et/ou de affb dans des collections classées sur la colonne 1.
À +, si de gros modules de services performants ne vous faisaient pas peur…

superbog · 23 Janvier 2017

Bonjour et merci,

mes réponses en bleu

Ça marche mais ça risque de devenir lent, c'est ça ?

Non le probleme n'est pas la lenteur mais le fait que ma macro n'est que partielle, elle ne fait que la première partie du boulot à savoir modifier les lignes existants dans affb quand il y a des nouveautés dans secl.

Mais une question me taraude: comment sait on qu'il y a des modifs dans affb ?

en ligne AZ il y a R

A t-on une autre feuille de son ancienne situation ?
On peut déterminer si tout est pareil dans affb et et dans secl mais si c'est différent, faut il faire autre chose selon qu'il y a "M" en colonne R ou pas
Et si une cellule est vide prendre l'autre, si aucune ne l'est prendre secl ? Qu'il y ait "M" ou pas ?
Je pourrais faire en sorte qu'on puisse avoir l'une derrière l'autre chaque paire de ligne on ligne isolée de secl et/ou de affb dans des collections classées sur la colonne 1.

pour mieux comprendre voici l'explication version vraie vie.
Le secrétariat tient la feuille des abonnés (secl). Il créé les nouveaux abonnés et les numérotes selon leur catégorie puis fait le tri, il modifie les abonnés déjà existants qui changent d'adresse ou autre.
le secrétariat n'a pas accès au fichier central (affb).
de son coté le fichier central reprend les nouveauté du secrétariat ainsi que les modifications. De temps à autre il fait une modification (qui doit alors être répercutée dans le secrétariat mais jamais il ne créé de nouveaux abonnés.
les macros automatiques, qui fonctionnent très bien, sur les pages abonnés de secl et affb notent automatiquement quand il y a eu une modif. dans secl cela ajoute M à la colonne R et dans dans affb cela ajoute R à la colonne AZ

Le but est de faire en sorte que depuis le fichier central je puisse lancer une macro qui va:
comparer les deux feuilles (pas les fichiers, les feuilles seulement), en prenant pour base de comparaison les chiffres de la colonne A qui contiennent (dans les deux feuilles) les numéros d'abonnés
modifier sur le fichier central ce qui a été modifié sur secl (visible grace à M) ou inversement (grace à R) en sachant que s'il y a M et R alors c'est M qui prime
ajouter sur fichier central les nouveaux abonnés créés sur secl en les mettants impérativement en fin de liste
vérifier sur fichier central que chaque cellule A est identique à la cellule R de la même ligne sauf pour les nouveaux ajouts et sinon faire un msgbox indiquant les numéros erronés

voilà j'espère que c'est plus clair

À +, si de gros modules de services performants ne vous faisaient pas peur…
PAS DE SOUCI AU CONTRAIRE

Dranreb à dit:
Bonsoir.
Ça marche mais ça risque de devenir lent, c'est ça ?
Mais une question me taraude: comment sait on qu'il y a des modifs dans affb ?
A t-on une autre feuille de son ancienne situation ?
On peut déterminer si tout est pareil dans affb et et dans secl mais si c'est différent, faut il faire autre chose selon qu'il y a "M" en colonne R ou pas ?
Et si une cellule est vide prendre l'autre, si aucune ne l'est prendre secl ? Qu'il y ait "M" ou pas ?
Je pourrais faire en sorte qu'on puisse avoir l'une derrière l'autre chaque paire de ligne on ligne isolée de secl et/ou de affb dans des collections classées sur la colonne 1.
À +, si de gros modules de services performants ne vous faisaient pas peur…

Dranreb · 23 Janvier 2017

Bonjour.
S'agit-il bien de mettre les deux listes en conformité, le secl n'étant pas qu'un simple fichier de mouvements de mise à jour à effectuer sur sur affb ?
En aucun cas insérer de ligne dans affb ?
Ça risque de compliquer sérieusement.
À moins que les nouveaux numéros soient toujours supérieurs à ceux qui existent déjà bien sûr: alors il n'y a rien de spécial à faire.

Edit: D'ailleurs :

superbog à dit:
… copie la ligne de secl dans affb en fin de page et trier par colonne A.

Non. Le plus simple c'est de réécrire complètement les deux listes classées, des deux cotés.

Edit 2: Oui j'étais passé à coté du "R" en az. Je vais rouvrir vos fichier pour voir si je trouve bien ce que vous dites. En résumé: mettre des deux cotés ce qu'il y a dans secl, sauf dans le seul cas où "R" est porté dans AZ de affb et que la colonne R de secl ne contient pas "M", alors mettre des deux cotés ce qu'il y a dans affb. Ces deux colonnes à tester doivent elles bien être effacées ensuite des deux cotés ?

(si au lieu des "M" et "R" 'il y avait une date/heure de dernière modif ce serait plus simple: on appliquerait partout le plus récent en y laissant celle ci)

superbog · 23 Janvier 2017

si c'est plus simple, on peut se limiter à une mise à jour à effectuer depuis secl, je m'abstiendrais de faire des modifs à partir de affb.
on peut insérer des lignes sur affb mais il faut bien faire attention à un point, qui d'ailleurs explique aussi pourquoi on ne peut pas effacer les lignes des deux côtés.
en effets les deux feuilles ne sont identiques que pour les colonnes A:Q ensuite, elles diffèrent et les infos qui sont dans les colonnes suivantes dans affb sont importantes et liées, ligne par ligne, au numéro d'abonné qui se trouve en A donc si l'on efface la ligne qui se trouve dans affb et qu'on la remplace par celle de secl, on perd ces données
même chose quand on ajoute une ligne, pas de pb pour l'ajouter mais il faut impérativement ajouter une ligne entière pour ne pas décaler les colonnes
enfin si l'on choisit l'option de mettre les deux listes en conformités, il sera très rare qu'il y ait à la fois M et R et l'idéal serait qu'apparaisse une boite de dialogue précisant les différences et donnant le choix à l'utilisateur

merci

Dranreb · 23 Janvier 2017

Voilà ce que j'avais fait avant de lire votre dernier poste.
Les colonnes R:AY des lignes existantes de affb devraient normalement être respectées.

Sub HarmoAffbSecl du module Applicatif2

superbog · 23 Janvier 2017

bonjour,

petit souci, quand j'ai recopié les modules dans les fichiers d'origine, enlevé le test, mis les chemins et lancé la macro HarmoAffbsecl (ci dessous), j'ai un message d'erreur 9 l'indice n'appartientpas à la selection et quand je demande le débogage, ce qui est en rouge ci dessous est surligné... sos
For Each Détail In Dos.Co
If Détail(0) = 0 Then
Src = Src Or 1: For C = 1 To 52: TAffb(L, C) = Détail(C): Next C

VB:

Option Explicit

Sub HarmoAffbSecl()
Dim ShAffb As Worksheet, ShSecl As Worksheet, Données As Collection, Src&, Dos As SsGr, TAffb(), TSecl(), L&, C&, Détail
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est ouvert
Set ShAffb = ThisWorkbook.Sheets("affb")
 

Workbooks.Open "C:\Users\brigitte\Dropbox\BB\xlbb\test\secl.xlsm" 'chemin à adapter
Set ShSecl = Workbooks("secl.xlsm").Sheets("Secl")
     
Set Données = Gigogne(TableUnique(PlgUti(ShAffb.[A2]), PlgUti(ShSecl.[A2])), 1)
ReDim TAffb(1 To Données.Count, 1 To 52), TSecl(1 To Données.Count, 1 To 18)
For Each Dos In Données
   Src = 0: L = L + 1
   For Each Détail In Dos.Co
      If Détail(0) = 0 Then
         Src = Src Or 1: For C = 1 To 52: TAffb(L, C) = Détail(C)[COLOR=#ff0000]: Next C[/COLOR]
      Else
         Src = Src Or 2: For C = 1 To 18: TSecl(L, C) = Détail(C)[SIZE=5][COLOR=#ff0000][B][U]: Next C[/U][/B][/COLOR][/SIZE]
         End If: Next Détail
   Select Case Src
      Case 1: ' Existe seulement dans TAffb
               For C = 1 To 17: TSecl(L, C) = TAffb(L, C): Next C
      Case 2: ' Existe seulement dans TSecl
               For C = 1 To 17: TAffb(L, C) = TSecl(L, C): Next C
      Case 3: ' Existe des deux cotés
         If TAffb(L, 52) = "R" And TSecl(L, 18) <> "M" Then
               For C = 1 To 17: TSecl(L, C) = TAffb(L, C): Next C
         Else
               For C = 1 To 17: TAffb(L, C) = TSecl(L, C): Next C
            End If
      End Select
   TAffb(L, 52) = Empty
   TSecl(L, 18) = Empty
   Next Dos
            #If PhaseTest Then
Set ShAffb = FThéoAffb
Set ShSecl = FThéoSecl
            #End If
Application.EnableEvents = False ' (En testant, j'ai chercher un moment pourquoi j'avais des "M" et "R" partout, Lol !)
ShAffb.[2:1000000].ClearContents
ShAffb.[A2].Resize(L, 52).Value = TAffb
ShSecl.[2:1000000].ClearContents
ShSecl.[A2].Resize(L, 18).Value = TSecl
Application.EnableEvents = True
            #If PhaseTest Then
            #Else
ThisWorkbook.Save
ShSecl.Parent.Close True
            #End If
MsgBox "Base mise à jour et enregistrée", vbInformation, "HarmoAffbSecl"
End Sub

Dranreb · 23 Janvier 2017

Cela semble venir de ce qu'il n'y a rien de renseigné en colonne 52 (AZ) de affb.
Le problème est résolu en corrigeant comme suit la fameuse instruction hightech :

VB:

Set Données = Gigogne(TableUnique(PlgUti(ShAffb.[A2], CMin:=52), PlgUti(ShSecl.[A2], CMin:=18)), 1)

Mais je vous conseille de faire de nombreux test avant de mettre en commentaire '#Const PhaseTest = 1
puis pour finir, un jour ou l'autre, supprimer les directives de compilation et les instructions de code associées à #If PhaseTest Then

superbog · 23 Janvier 2017

A priori cela parait parfaitement fonctionner, j'ai enlevé la phase test car les fichiers que j'utilise sont des fichiers test donc peu importe s'ils crashent
j'ai noté que si il y avait des changements dans secl et affb, secl prenait la main, pas d'option ni de demande?

Dranreb · 23 Janvier 2017

Oui, c'est ce que j'avais cru comprendre qu'il fallait. Mais vous pouvez toujours ajouter des conditions dans la partie Case 3: ' Existe des deux cotés, voire si c'est assez rare un If MsgBox(… ,VbExclamation+vbYesNo, "HarmoAffbSecl") = vbNo Then … Else pour inverser le sens du mouvement ou laisser comme c'est des deux cotés, etc.
Si les gros modules de services performants ne vous font pas peur vous devez bien savoir un peu programmer les choses assez simples, non ?

superbog · 23 Janvier 2017

merci de tout coeur, vous m'avez vraiment aidé
en fait je fais plutôt de l'entassement de petits modules simples car je n'ai aucune formation excel, contrairement à vous à l'évidence

a force de m'échiner je parviens à quelque chose mais souvent je butte...

ainsi par exemple j'ai une macro d'envoi par gmail qui fonctionne très bien mais au bout de trois ou quatre envois, ça plante excel...

XL 2010 faire une copie par comparaison de cellule avec priorité de sens

superbog

XLDnaute Occasionnel

Pièces jointes

Dranreb

XLDnaute Barbatruc

superbog

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

superbog

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Pièces jointes

superbog

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

superbog

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

superbog

XLDnaute Occasionnel

Discussions similaires