Sujet Précédent Sujet Suivant

Rechercher des valeurs d'un tableau vers un autre

Résolu/Fermé
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015 - 22 juil. 2014 à 15:36
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 28 juil. 2014 à 14:17
Bonjour à tous,

J'ai actuellement deux classeurs Excel: un ancien et un nouveau. Dans chacun de ces classeurs, il y a une feuille "Items" avec en A des matricules.
Je souhaiterais récupérer dans une nouvelle feuille, du nouveau classeur, nommé "New_items", les lignes dont le matricule apparaît dans le nouveau classeur mais pas dans l'ancien classeur. Pour ce faire, j'ai mis à ma sauce une macro récupérée sur un forum et voilà ce que ça donne : 
Sub Nouvelles_Refs()
'
' Nouvelles_Refs Macro
'
Dim NomAncien As String 'Nom de l'ancien fichier
Dim NomNouvo As String 'Nom du nouveau fichier
Dim C As Variant
Dim Ref As Variant
Dim nvlref As Long
nvlref = 2
NomNouvo = ThisWorkbook.Name
NomAncien = Workbooks(NomNouvo).Worksheets("Procedure").Range("B2").Value

Dim ligneAncien As Long 
ligneAncien = 3
'Compter le nombre de ligne de l'ancien fichier
While Workbooks(NomAncien).Worksheets("Items").Range("A" & ligneAncien) <> ""
    ligneAncien = ligneAncien + 1
Wend

Dim ligneNouvo As Long
ligneNouvo = 3
'compter le nombre de ligne du nouveau fichier
While Workbooks(NomNouvo).Worksheets("Items").Cells(ligneNouvo, 1) <> ""
    ligneNouvo = ligneNouvo + 1
Wend

For i = 3 To ligneNouvo - 1
    Ref = Range("A" & i).Value
    Set C = Nothing
    Set C = Workbooks(NomAncien).Worksheets("Items").Range("A3:A" & ligneAncien).Find(what:=Ref, LookAt:=xlWhole, MatchCase:=False)
        If C Is Nothing Then
            Workbooks(NomNouvo).Worksheets("Items").Rows(i).Copy
            Sheets("New_items").Select
            Rows(nvlref).Select
            ActiveSheet.Paste
            nvlref = nvlref + 1
            Sheets("Items").Range("A" & i).Calculate
        End If
Next i

'
End Sub

Voilà le problème est que malgré ma boucle for, la condition "if" ne marche qu'une seule fois (une seule ligne est copiée dans l'onglet "new items", cette seule ligne est en fait la première ligne repérée par la macro) alors que deux lignes devraient être copiées dans cette feuille "new_items".

Voilà, j'espère avoir été assez clair, si ce n'est pas le cas n'hésitez pas à me poser toutes les questions que vous pourrez avoir, et je suis désolé si le code est moche, mais je ne suis qu'un novice et je n'ai pas encore toutes les bonnes habitudes que vous pourriez avoir ^^

Merci d'avance,
Ecrelinf.

PS : vous trouverez les-dits fichiers en suivant les liens ci-dessous.
Ancien : https://www.cjoint.com/?0GwpGCWjWUP
Nouveau : https://www.cjoint.com/?0GwpHGKGyoq
A voir également:

5 réponses

Réponse 1 / 5
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
Modifié par pijaku le 24/07/2014 à 10:52
Salut,

Grrrr!
Je fais toujours cette même erreur de débutant sur les variables tableaux. Ça m'apprendra à ne pas tester...
En fait, une variable tableau à deux dimensions (Tb(2, 3)), si l'on souhaite qu'elle soit dynamique, on ne peux que faire évoluer, incrémenter, la seconde dimension. C'est à dire que ceci : 
Tb(i, 2)
ne peut pas être. Par contre, 
Tb(2, i)
, oui!
Ensuite, lors de la restitution de la variable tableau dans la feuille, afin de remettre les lignes en colonnes et inversement, il nous faudra utiliser 
Application.Transpose
.
J'en ai profité pour corriger un petit bug dans le FindNext de la fin...
Ne t'inquiète pas pour :
Je suis en train de recopier le code et je me demandais si le fait d'utiliser la même variable IndTbNouvo danhs la ligne

If Tb_Nouvo(IndTbNouvo, Col) <> Tb_Ancien(mesRef_Ancien(Tb_Nouvo(IndTbNouvo, 1)), Col) Then

ne signifie pas que les références sont forcément placées à la même ligne ?
Normalement, c'est bon comme ça!
ou pas...
On verra, c'est selon...
Des fois ça marrrrche et desw fois ça marrrche pas... 

Option Explicit

Sub Refs_modif()
'
' Refs_modif Macro
'
Dim Tb_Ancien(), Tb_Nouvo(), Tb_Out()
Dim mesRef_Ancien As Object
Dim Trouve As Range

Dim NomAncien As String, NomNouvo As String, firstAddress As String
Dim ligneAncien As Long, ligneNouvo As Long, IndTbNouvo As Long
Dim i As Long, j As Long, DLig As Long, Col As Byte

Dim Modif As Boolean

'--------------------- STOCKAGE DES DONNEES DANS LES VARIABLES ---------------------------
'je récupère les noms de mes deux fichiers
NomNouvo = ThisWorkbook.Name
NomAncien = Workbooks(NomNouvo).Worksheets("Procedure").Range("B2").Value

    '**** STOCKAGE DE TOUTES LES DONNEES DE L'ANCIEN CLASSEUR
With Workbooks(NomAncien).Worksheets("Items")
    'je compte le nombre de ligne dans mon ancien tableau
    ligneAncien = .Range("A" & Rows.Count).End(xlUp).Row
    'Stockage de toutes les données de Cells(1, 1) à Cells(ligneAncien, 53)
    Tb_Ancien = .Range(.Cells(1, 1), .Cells(ligneAncien, 53)).Value
    '********** STOCKAGE DE LA LISTE DES REFERENCES DE L'ANCIEN TABLEAU
    Set mesRef_Ancien = CreateObject("Scripting.Dictionary")
    For i = LBound(Tb_Ancien) To UBound(Tb_Ancien)
        mesRef_Ancien(Tb_Ancien(i, 1)) = i
    Next i
End With

    '**** STOCKAGE DE TOUTES LES DONNEES DU NOUVEAU CLASSEUR
With Workbooks(NomNouvo).Worksheets("Items")
'je compte le nombre de ligne dans mon nouveau tableau
    ligneNouvo = .Range("A" & Rows.Count).End(xlUp).Row
    'Stockage de toutes les données de Cells(1, 1) à Cells(ligneNouvo, 53)
    Tb_Nouvo = .Range(.Cells(1, 1), .Cells(ligneNouvo, 53)).Value
End With


'--------------------- TEST DES DONNEES ET REMPLISSAGE TABLEAU DE SORTIE : ---------------------------
'boucle sur les références du nouveau tableau
For IndTbNouvo = 1 To UBound(Tb_Nouvo, 1) '!!!!!!!!!!!!!!!! Si la feuille contient une ligne d'entête, commencer à 2
    Modif = False
    'Si elle existe dans les références de l'ancien
    If mesRef_Ancien.exists(Tb_Nouvo(IndTbNouvo, 1)) Then
        'On vérifie s'il y a eu des modifs dans les 53 colonnes :
        For Col = 2 To 53
            If Tb_Nouvo(IndTbNouvo, Col) <> Tb_Ancien(mesRef_Ancien(Tb_Nouvo(IndTbNouvo, 1)), Col) Then
                'on note qu'il y a eu modification sur cette ligne
                Modif = True
                'on repère la cellule modifiée
                Tb_Nouvo(IndTbNouvo, Col) = Tb_Nouvo(IndTbNouvo, Col) & " ¤ "
            End If
        Next Col
        'On stocke la ligne si elle a été modifiée :
        If Modif Then
            j = j + 1
            ReDim Preserve Tb_Out(1 To 53, 1 To j)
            For Col = 1 To 53
                Tb_Out(Col, j) = Tb_Nouvo(IndTbNouvo, Col)
            Next
        End If
    End If
Next IndTbNouvo

'--------------------- RESTITUTION DES DONNEES ---------------------------
With Workbooks(NomNouvo).Worksheets("Feuil4") 'A ADAPTER!!!
    .Cells.Clear        '!!!!!!!!!!!!!!!!!! SUPPRIME TOUTES LES CELLULES DE LA FEUILLE !!!!!!!!!!!!!!!!!!
    .Range("A2").Resize(UBound(Tb_Out, 2), 53) = Application.Transpose(Tb_Out)
End With

'--------------------- LE COLORIAGE DES CELLULES MODIFIEES ---------------------------
With Workbooks(NomNouvo).Worksheets("Feuil4") 'A ADAPTER!!!
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    With .Range("A1:BA" & DLig)
        Set Trouve = .Find(" ¤ ")
        If Not Trouve Is Nothing Then
            firstAddress = Trouve.Address
            Do
                'on efface le signe de repérage : ¤
                Trouve.Value = Left(Trouve.Value, Len(Trouve.Value) - 3)
                'on colorie en rouge
                Trouve.Interior.Color = 255
                'on cherche la suivante
                Set Trouve = .FindNext(Trouve)
                If Trouve Is Nothing Then Exit Do
            Loop While Trouve.Address <> firstAddress
        End If
    End With
    .Select
End With
End Sub


Cordialement,
Franck
1
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
24 juil. 2014 à 09:51
Merci Franck pour ton aide !
Cependant il semblerait que le petit bug du code-qui-ne-veut-pas-s'afficher est revenu ... ^^
Bonne journée !
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
24 juil. 2014 à 10:52
Et là??? 
Option Explicit

Sub Refs_modif()
'
' Refs_modif Macro
'
Dim Tb_Ancien(), Tb_Nouvo(), Tb_Out()
Dim mesRef_Ancien As Object
Dim Trouve As Range

Dim NomAncien As String, NomNouvo As String, firstAddress As String
Dim ligneAncien As Long, ligneNouvo As Long, IndTbNouvo As Long
Dim i As Long, j As Long, DLig As Long, Col As Byte

Dim Modif As Boolean

'--------------------- STOCKAGE DES DONNEES DANS LES VARIABLES ---------------------------
'je récupère les noms de mes deux fichiers
NomNouvo = ThisWorkbook.Name
NomAncien = Workbooks(NomNouvo).Worksheets("Procedure").Range("B2").Value

    '**** STOCKAGE DE TOUTES LES DONNEES DE L'ANCIEN CLASSEUR
With Workbooks(NomAncien).Worksheets("Items")
    'je compte le nombre de ligne dans mon ancien tableau
    ligneAncien = .Range("A" & Rows.Count).End(xlUp).Row
    'Stockage de toutes les données de Cells(1, 1) à Cells(ligneAncien, 53)
    Tb_Ancien = .Range(.Cells(1, 1), .Cells(ligneAncien, 53)).Value
    '********** STOCKAGE DE LA LISTE DES REFERENCES DE L'ANCIEN TABLEAU
    Set mesRef_Ancien = CreateObject("Scripting.Dictionary")
    For i = LBound(Tb_Ancien) To UBound(Tb_Ancien)
        mesRef_Ancien(Tb_Ancien(i, 1)) = i
    Next i
End With

    '**** STOCKAGE DE TOUTES LES DONNEES DU NOUVEAU CLASSEUR
With Workbooks(NomNouvo).Worksheets("Items")
'je compte le nombre de ligne dans mon nouveau tableau
    ligneNouvo = .Range("A" & Rows.Count).End(xlUp).Row
    'Stockage de toutes les données de Cells(1, 1) à Cells(ligneNouvo, 53)
    Tb_Nouvo = .Range(.Cells(1, 1), .Cells(ligneNouvo, 53)).Value
End With


'--------------------- TEST DES DONNEES ET REMPLISSAGE TABLEAU DE SORTIE : ---------------------------
'boucle sur les références du nouveau tableau
For IndTbNouvo = 1 To UBound(Tb_Nouvo, 1) '!!!!!!!!!!!!!!!! Si la feuille contient une ligne d'entête, commencer à 2
    Modif = False
    'Si elle existe dans les références de l'ancien
    If mesRef_Ancien.exists(Tb_Nouvo(IndTbNouvo, 1)) Then
        'On vérifie s'il y a eu des modifs dans les 53 colonnes :
        For Col = 2 To 53
            If Tb_Nouvo(IndTbNouvo, Col) <> Tb_Ancien(mesRef_Ancien(Tb_Nouvo(IndTbNouvo, 1)), Col) Then
                'on note qu'il y a eu modification sur cette ligne
                Modif = True
                'on repère la cellule modifiée
                Tb_Nouvo(IndTbNouvo, Col) = Tb_Nouvo(IndTbNouvo, Col) & " ¤ "
            End If
        Next Col
        'On stocke la ligne si elle a été modifiée :
        If Modif Then
            j = j + 1
            ReDim Preserve Tb_Out(1 To 53, 1 To j)
            For Col = 1 To 53
                Tb_Out(Col, j) = Tb_Nouvo(IndTbNouvo, Col)
            Next
        End If
    End If
Next IndTbNouvo

'--------------------- RESTITUTION DES DONNEES ---------------------------
With Workbooks(NomNouvo).Worksheets("Feuil4") 'A ADAPTER!!!
    .Cells.Clear        '!!!!!!!!!!!!!!!!!! SUPPRIME TOUTES LES CELLULES DE LA FEUILLE !!!!!!!!!!!!!!!!!!
    .Range("A2").Resize(UBound(Tb_Out, 2), 53) = Application.Transpose(Tb_Out)
End With

'--------------------- LE COLORIAGE DES CELLULES MODIFIEES ---------------------------
With Workbooks(NomNouvo).Worksheets("Feuil4") 'A ADAPTER!!!
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    With .Range("A1:BA" & DLig)
        Set Trouve = .Find(" ¤ ")
        If Not Trouve Is Nothing Then
            firstAddress = Trouve.Address
            Do
                'on efface le signe de repérage : ¤
                Trouve.Value = Left(Trouve.Value, Len(Trouve.Value) - 3)
                'on colorie en rouge
                Trouve.Interior.Color = 255
                'on cherche la suivante
                Set Trouve = .FindNext(Trouve)
                If Trouve Is Nothing Then Exit Do
            Loop While Trouve.Address <> firstAddress
        End If
    End With
    .Select
End With
End Sub
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
24 juil. 2014 à 10:55
En ce qui concerne le bug d'affichage du code, je pencherais pour une (énième) boulette de ton navigateur IE8.....
A vérifier.
0
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
28 juil. 2014 à 09:58
Bonjour Franck,

Merci pour ton aide, le code fonctionne presque entièrement chez moi ! ^^^
En effet les cellules sont bien repérées et copiées, le seul problème c'est que la macro n'arrive pas à retrouver les cases ayant le signe de repérage " ¤ " et donc mes cases contiennent toujours le-dit signe et ne sont pas coloriées :/
pourtant je ne vois rien qui cloche dans le code, je suis confus ^^'

Je te renvoie les fichiers anciens et nouveaux si jamais tu réussis à trouver le petit truc qu'il me manque !

Ancien : https://www.cjoint.com/?0GCj43DVtQF
Nouveau : https://www.cjoint.com/?0GCj5ZsEACc

Merci beaucoup,

Ecrelinf
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
28 juil. 2014 à 10:19
Bonjour,

Je viens d'essayer avec tes deux fichiers. Résultat des cellules coloriées en rouge, sans ¤.....
0
Réponse 2 / 5
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 22/07/2014 à 23:18
Bonjour

Dans la réalité, combien as tu de lignes (environ) dans tes classeurs ?
les solutions possibles pourront être différentes suivant ce nombre...

Le classeur ancien est il ouvert au lancement de la macro (apparemment oui, mais...) ?

Michel
0
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
23 juil. 2014 à 09:50
oui oui le classeur ancien est ouvert au moment de la macro, j'ai trouvé une solution en passant pas mal de temps sur google et ça semble marcher avec peu de valeurs (mes tableaux font 8000 lignes donc à voir si ça fonctionne). Je poste la macro au cas où quelqu'un chercherait une solution : 

'COMPARAISON DE 2 BD;REVU ET CORRIGÉ FLA 24.03.08
'CRITÈRE DE COMPARAISON :ITEMS EN COLONNE A; À DÉFINIR
'RÉCUPÉRATION DES ITEMS DIFFÉRENTS ENTRE SBD1 ET SBD2
'UTILISATION DE LA MÉTHODE DIRECTE
Sub BD1NonBD2()
Dim C As Variant, X As Variant
Dim Actuel&, Kl&, I&, Vcol&
Dim Sbd1 As Worksheet, Sbd2 As Worksheet, Cible As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set Sbd1 = Feuil1
Set Sbd2 = Feuil2
'Vcol dernière colonne de la base
Vcol = Feuil1.Cells.Find("*", [A1], -4123, , 1, 2).Column
Actuel = 2: Kl = Sbd1.[A65000].End(xlUp).Row + 1
Set Cible = Feuil5
'Raz des traitements précédents
Cible.Range("A1").Offset(1, 0).Resize(Kl, Vcol).ClearContents
Sbd1.Range("A1").Offset(1, 0).Resize(Kl, Vcol).Interior.ColorIndex = xlNone
'Traitement de la base 1
    For I = 2 To Kl
      X = Sbd1.Cells(I, 1)
    'optionnel pour les données numériques
    ' X = TrimZéro(Trim(Sbd1.Cells(I, 1)))
    ' Option xlWhole ou xlpart
      Set C = Sbd2.[A:A].Find(what:=X, LookAt:=xlWhole, MatchCase:=False)
      If C Is Nothing Then
     'pour récupérer les items identiques le code sera
     ' If not C Is Nothing Then
     'Copie de la zone source vers la feuille cible
         Cible.Cells(Actuel, 1).Resize(1, Vcol).Value = _
           Sbd1.Cells(I, 1).Resize(1, Vcol).Value
     'indexation du compteur de ligne pour la copie
         Actuel = Actuel + 1
         Sbd1.Cells(I, 1).Interior.ColorIndex = 33
         Sbd1.Cells(I, 1).Calculate
      End If
    Next I
Feuil5.Range("a1:e1").Value = Feuil1.Range("a1:e1").Value
Application.GoTo reference:=Feuil5.Cells(2, 1), Scroll:=True
Application.Calculation = xlCalculationAutomatic
Set Sbd1 = Nothing:    Set Sbd2 = Nothing
Set C = Nothing: Set Cible = Nothing
End Sub

Merci Michel.m ! Et bonne journée ;)
0
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
23 juil. 2014 à 09:54
Bonjour Michel_m,

oui oui le classeur ancien est bien ouvert au lancement de la macro. J'ai trouvé une solution grâce à google qui fonctionne avec peu de valeurs (mes tableaux font approximativement 8000 lignes donc à voir si ça fonctionne ...) Je poste quand même le code au cas où quelqu'un en aurait besoin : 

'COMPARAISON DE 2 BD;REVU ET CORRIGÉ FLA 24.03.08
'CRITÈRE DE COMPARAISON :ITEMS EN COLONNE A; À DÉFINIR
'RÉCUPÉRATION DES ITEMS DIFFÉRENTS ENTRE SBD1 ET SBD2
'UTILISATION DE LA MÉTHODE DIRECTE
Sub BD1NonBD2()
Dim C As Variant, X As Variant
Dim Actuel&, Kl&, I&, Vcol&
Dim Sbd1 As Worksheet, Sbd2 As Worksheet, Cible As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set Sbd1 = Feuil1
Set Sbd2 = Feuil2
'Vcol dernière colonne de la base
Vcol = Feuil1.Cells.Find("*", [A1], -4123, , 1, 2).Column
Actuel = 2: Kl = Sbd1.[A65000].End(xlUp).Row + 1
Set Cible = Feuil5
'Raz des traitements précédents
Cible.Range("A1").Offset(1, 0).Resize(Kl, Vcol).ClearContents
Sbd1.Range("A1").Offset(1, 0).Resize(Kl, Vcol).Interior.ColorIndex = xlNone
'Traitement de la base 1
    For I = 2 To Kl
      X = Sbd1.Cells(I, 1)
    'optionnel pour les données numériques
    ' X = TrimZéro(Trim(Sbd1.Cells(I, 1)))
    ' Option xlWhole ou xlpart
      Set C = Sbd2.[A:A].Find(what:=X, LookAt:=xlWhole, MatchCase:=False)
      If C Is Nothing Then
     'pour récupérer les items identiques le code sera
     ' If not C Is Nothing Then
     'Copie de la zone source vers la feuille cible
         Cible.Cells(Actuel, 1).Resize(1, Vcol).Value = _
           Sbd1.Cells(I, 1).Resize(1, Vcol).Value
     'indexation du compteur de ligne pour la copie
         Actuel = Actuel + 1
         Sbd1.Cells(I, 1).Interior.ColorIndex = 33
         Sbd1.Cells(I, 1).Calculate
      End If
    Next I
Feuil5.Range("a1:e1").Value = Feuil1.Range("a1:e1").Value
Application.GoTo reference:=Feuil5.Cells(2, 1), Scroll:=True
Application.Calculation = xlCalculationAutomatic
Set Sbd1 = Nothing:    Set Sbd2 = Nothing
Set C = Nothing: Set Cible = Nothing
End Sub

Merci quand même pour ton aide Michel_m (mais je planche sur une autre macro actuellement, alors ne t'en va pas trop loin ahah ^^)

Bonne journée,
Ecrelinf
0
Réponse 3 / 5
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
23 juil. 2014 à 10:44
Pourquoi faire un doublon ?
https://forums.commentcamarche.net/forum/affich-30547876-comparer-deux-longues-lignes

Abandon du suivi sur ces 2 postS
0
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
23 juil. 2014 à 11:10
Ce n'est pas un doublon, j'ai créé une autre discussion car je ne recherche plus la même chose ;) Celle ci est résolue.
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
23 juil. 2014 à 11:16
mais je planche sur une autre macro actuellement, alors ne t'en va pas trop loin
L'autre discussion est fermée car tout peut se faire sur celle-ci. Ce ne serait pas la première fois qu'un sujet évoluerait, loin s'en faut.
Fin de la discussion sur doublon ou pas.

Reprenez le fil du sujet ou vous en étiez, quitte à refaire un laïus complet sur ce que vous souhaitez faire...
0
Réponse 4 / 5
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
Modifié par Ecrelinf le 23/07/2014 à 11:39
Bonjour Pijaku,

Ce n'était pas vraiment un doublon, puisque je ne cherchais pas vraiment la même chose (même si au final on parle de la même macro ;))
Cette macro a deux objectifs :

1) Comparer un fichier et sa mise à jour, repérer les nouvelles références et copier ces références ainsi que toutes les données dans une nouvelle feuille (c'était l'objet de cette discussion mais le problème est résolu)

2) Comparer un fichier et sa mise à jour, repérer les données qui ont été modifiées pour une même référence et copier les lignes modifiée dans un nouvel onglet (c'était l'objet de la nouvelle discussion ouverte, autant continuer ici c'est vrai, désolé pour ma gaffe je ne suis pas un habitué des forums).

Concernant le deuxième point, Pijaku tu me parles de variable tableau, que je ne connais pas. Je vais de ce pas me renseigner un peu et je reviens vers toi ;)

Cependant j'ai quand même commencé la macro évoquée dans l'autre discussion et j'ai un problème, ma boucle for ne se lance pas. Voici le code : 

Sub Refs_modif()
'
' Refs_modif Macro
'
Dim NomAncien As String
Dim NomNouvo As String
Dim a As Long
Dim b As Long

'je récupère les noms de mes deux fichiers
NomNouvo = ThisWorkbook.Name
NomAncien = Workbooks(NomNouvo).Worksheets("Procedure").Range("B2").Value

'je compte le nombre de ligne dans mon ancien tableau 
Dim ligneAncien As Long
ligneAncien = 1
While Workbooks(NomAncien).Worksheets("Items").Range("A" & ligneAncien) <> ""
    ligneAncien = ligneAncien + 1
Wend

'je compte le nombre de ligne dans mon nouveau tableau 
Dim ligneNouvo As Long
ligneNouvo = 1
While Workbooks(NomNouvo).Worksheets("Items").Cells(ligneNouvo, 1) <> ""
    ligneNouvo = ligneNouvo + 1
Wend

'Je lance mes deux boucles for
For a = 1 To ligneNouveau
    For b = 1 To ligneAncien
        'je repère les références identiques
           If Workbooks(NomNouvo).Sheets("Items").Range("A" & a).Value = _
           Workbooks(NomAncien).Sheets("Items").Range("A" & b).Value Then
                'Les deux ifs qui suivent : comparer les données en B et C
                'si les données diffèrent, je colorie mes cellule
                'et ajoute un "1" en BB qui est mon repère pour pouvoir les coller
                'dans une nouvelle feuille plus tard
                If Workbooks(NomNouvo).Sheets("Items").Range("B" & a).Value <> _
                   Workbooks(NomAncien).Sheets("Items").Range("B" & b).Value Then
                   Workbooks(NomNouvo).Sheets("Items").Range("B" & a).Interrior.ColorIndex = 33
                   Workbooks(NomNouvo).Sheets("Items").Range("BB" & a).Value = "1"
                End If
                If Workbooks(NomNouvo).Sheets("Items").Range("C" & a).Value <> _
                   Workbooks(NomAncien).Sheets("Items").Range("C" & b).Value Then
                   Workbooks(NomNouvo).Sheets("Items").Range("C" & a).Interrior.ColorIndex = 33
                   Workbooks(NomNouvo).Sheets("Items").Range("BB" & a).Value = "1"
                End If
        End If
    Next b
Next a

MsgBox a
MsgBox b

End Sub

En effet, les msgbox a et b me renvoient a = 1 et b = 0 ...

Même moi je me rends compte que je fais vraiment du bricolage, je fais avec les moyens du bord ... :/

Merci d'avance pour votre aide,
Ecrelinf
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
23 juil. 2014 à 11:29
Connais tu les variables tableau?
0
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
23 juil. 2014 à 12:28
Pijaku, je me suis renseigné un peu sur les variables tableau, mais je ne vois pas trop comment les utiliser puisque mes références ne sont pas forcément sur les mêmes lignes d'un tableau à l'autre.
Exemple :
Je peux avoir la référence AB154 en ligne 14 sur le tableau Ancien et la même référence AB154 en ligne 45.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
Modifié par pijaku le 23/07/2014 à 12:30
Voici mon "premier jet".
Cela donne une macro relativement complexe, dis moi si c'est bien le résultat attendu...
Attention à adapter ce qui doit l'être, notamment la feuille de "sortie"... Lis donc tous les commentaires de la macro... 

Option Explicit

Sub Refs_modif()
'
' Refs_modif Macro
'
Dim Tb_Ancien(), Tb_Nouvo(), Tb_Out()
Dim mesRef_Ancien As Object
Dim Trouve As Range

Dim NomAncien As String, NomNouvo As String, firstAddress As String
Dim ligneAncien As Long, ligneNouvo As Long, IndTbNouvo As Long
Dim i As Long, j As Long, DLig As Long, Col As Byte

Dim Modif As Boolean

'--------------------- STOCKAGE DES DONNEES DANS LES VARIABLES ---------------------------
'je récupère les noms de mes deux fichiers
NomNouvo = ThisWorkbook.Name
NomAncien = Workbooks(NomNouvo).Worksheets("Procedure").Range("B2").Value

    '**** STOCKAGE DE TOUTES LES DONNEES DE L'ANCIEN CLASSEUR
With Workbooks(NomAncien).Worksheets("Items")
    'je compte le nombre de ligne dans mon ancien tableau
    ligneAncien = .Range("A" & Rows.Count).End(xlUp).Row
    'Stockage de toutes les données de Cells(1, 1) à Cells(ligneAncien, 53)
    Tb_Ancien = .Range(.Cells(1, 1), .Cells(ligneAncien, 53)).Value
    '********** STOCKAGE DE LA LISTE DES REFERENCES DE L'ANCIEN TABLEAU
    Set mesRef_Ancien = CreateObject("Scripting.Dictionary")
    For i = LBound(Tb_Ancien) To UBound(Tb_Ancien)
        mesRef_Ancien(Tb_Ancien(i, 1)) = i
    Next i
End With

    '**** STOCKAGE DE TOUTES LES DONNEES DU NOUVEAU CLASSEUR
With Workbooks(NomNouvo).Worksheets("Items")
'je compte le nombre de ligne dans mon nouveau tableau
    ligneNouvo = .Range("A" & Rows.Count).End(xlUp).Row
    'Stockage de toutes les données de Cells(1, 1) à Cells(ligneNouvo, 53)
    Tb_Nouvo = .Range(.Cells(1, 1), .Cells(ligneNouvo, 53)).Value
End With


'--------------------- TEST DES DONNEES ET REMPLISSAGE TABLEAU DE SORTIE : ---------------------------
'boucle sur les références du nouveau tableau
For IndTbNouvo = 1 To UBound(Tb_Nouvo, 1) '!!!!!!!!!!!!!!!! Si la feuille contient une ligne d'entête, commencer à 2
    Modif = False
    'Si elle existe dans les références de l'ancien
    If mesRef_Ancien.exists(Tb_Nouvo(IndTbNouvo, 1)) Then
        'On vérifie s'il y a eu des modifs dans les 53 colonnes :
        For Col = 2 To 53
            If Tb_Nouvo(IndTbNouvo, Col) <> Tb_Ancien(mesRef_Ancien(Tb_Nouvo(IndTbNouvo, 1)), Col) Then
                'on note qu'il y a eu modification sur cette ligne
                Modif = True
                'on repère la cellule modifiée
                Tb_Nouvo(IndTbNouvo, Col) = Tb_Nouvo(IndTbNouvo, Col) & " ¤ "
            End If
        Next Col
        'On stocke la ligne si elle a été modifiée :
        If Modif Then
            j = j + 1
            ReDim Preserve Tb_Out(1 To j, 1 To 53)
            For Col = 1 To 53
                Tb_Out(j, Col) = Tb_Nouvo(IndTbNouvo, Col)
            Next
        End If
    End If
Next IndTbNouvo

'--------------------- RESTITUTION DES DONNEES ---------------------------
With Workbooks(NomNouvo).Worksheets("Feuil4") 'A ADAPTER!!!
    .Range("A2").Resize(UBound(Tb_Out, 1), 53) = Tb_Out
End With

'--------------------- LE COLORIAGE DES CELLULES MODIFIEES ---------------------------
With Workbooks(NomNouvo).Worksheets("Feuil4")
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    With .Range("A1:BA" & DLig)
        Set Trouve = .Find("¤")
        If Not Trouve Is Nothing Then
            firstAddress = Trouve.Address
            Do While Not Trouve Is Nothing And Trouve.Address <> firstAddress
                'on efface le signe de repérage : ¤
                Trouve.Value = Left(Trouve.Value, Len(Trouve.Value) - 3)
                'on colorie en rouge
                Trouve.Interior.Color = 255
                'on cherche la suivante
                Set Trouve = .FindNext(Trouve)
            Loop
        End If
    End With
End With
End Sub


Code réalisé sans fichiers de test..... A voir donc


Cordialement,
Franck
0
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
23 juil. 2014 à 14:47
Y'a-t-il une manip à faire pour récupérer la macro car je ne vois que la première ligne ?

En tout cas merci pour ta disponibilité Franck !
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
Modifié par pijaku le 23/07/2014 à 15:01
Non il s'agit d'un bug qui revient de temps à autre..... 
Option Explicit

Sub Refs_modif()
'
' Refs_modif Macro
'
Dim Tb_Ancien(), Tb_Nouvo(), Tb_Out()
Dim mesRef_Ancien As Object
Dim Trouve As Range

Dim NomAncien As String, NomNouvo As String, firstAddress As String
Dim ligneAncien As Long, ligneNouvo As Long, IndTbNouvo As Long
Dim i As Long, j As Long, DLig As Long, Col As Byte

Dim Modif As Boolean

'--------------------- STOCKAGE DES DONNEES DANS LES VARIABLES ---------------------------
'je récupère les noms de mes deux fichiers
NomNouvo = ThisWorkbook.Name
NomAncien = Workbooks(NomNouvo).Worksheets("Procedure").Range("B2").Value

    '**** STOCKAGE DE TOUTES LES DONNEES DE L'ANCIEN CLASSEUR
With Workbooks(NomAncien).Worksheets("Items")
    'je compte le nombre de ligne dans mon ancien tableau
    ligneAncien = .Range("A" & Rows.Count).End(xlUp).Row
    'Stockage de toutes les données de Cells(1, 1) à Cells(ligneAncien, 53)
    Tb_Ancien = .Range(.Cells(1, 1), .Cells(ligneAncien, 53)).Value
    '********** STOCKAGE DE LA LISTE DES REFERENCES DE L'ANCIEN TABLEAU
    Set mesRef_Ancien = CreateObject("Scripting.Dictionary")
    For i = LBound(Tb_Ancien) To UBound(Tb_Ancien)
        mesRef_Ancien(Tb_Ancien(i, 1)) = i
    Next i
End With

    '**** STOCKAGE DE TOUTES LES DONNEES DU NOUVEAU CLASSEUR
With Workbooks(NomNouvo).Worksheets("Items")
'je compte le nombre de ligne dans mon nouveau tableau
    ligneNouvo = .Range("A" & Rows.Count).End(xlUp).Row
    'Stockage de toutes les données de Cells(1, 1) à Cells(ligneNouvo, 53)
    Tb_Nouvo = .Range(.Cells(1, 1), .Cells(ligneNouvo, 53)).Value
End With


'--------------------- TEST DES DONNEES ET REMPLISSAGE TABLEAU DE SORTIE : ---------------------------
'boucle sur les références du nouveau tableau
For IndTbNouvo = 1 To UBound(Tb_Nouvo, 1) '!!!!!!!!!!!!!!!! Si la feuille contient une ligne d'entête, commencer à 2
    Modif = False
    'Si elle existe dans les références de l'ancien
    If mesRef_Ancien.exists(Tb_Nouvo(IndTbNouvo, 1)) Then
        'On vérifie s'il y a eu des modifs dans les 53 colonnes :
        For Col = 2 To 53
            If Tb_Nouvo(IndTbNouvo, Col) <> Tb_Ancien(mesRef_Ancien(Tb_Nouvo(IndTbNouvo, 1)), Col) Then
                'on note qu'il y a eu modification sur cette ligne
                Modif = True
                'on repère la cellule modifiée
                Tb_Nouvo(IndTbNouvo, Col) = Tb_Nouvo(IndTbNouvo, Col) & " ¤ "
            End If
        Next Col
        'On stocke la ligne si elle a été modifiée :
        If Modif Then
            j = j + 1
            ReDim Preserve Tb_Out(1 To j, 1 To 53)
            For Col = 1 To 53
                Tb_Out(j, Col) = Tb_Nouvo(IndTbNouvo, Col)
            Next
        End If
    End If
Next IndTbNouvo

'--------------------- RESTITUTION DES DONNEES ---------------------------
With Workbooks(NomNouvo).Worksheets("Feuil4") 'A ADAPTER!!!
    .Range("A2").Resize(UBound(Tb_Out, 1), 53) = Tb_Out
End With

'--------------------- LE COLORIAGE DES CELLULES MODIFIEES ---------------------------
With Workbooks(NomNouvo).Worksheets("Feuil4")
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    With .Range("A1:BA" & DLig)
        Set Trouve = .Find(" ¤ ")
        If Not Trouve Is Nothing Then
            firstAddress = Trouve.Address
            Do While Not Trouve Is Nothing And Trouve.Address <> firstAddress
                'on efface le signe de repérage : ¤
                Trouve.Value = Left(Trouve.Value, Len(Trouve.Value) - 3)
                'on colorie en rouge
                Trouve.Interior.Color = 255
                'on cherche la suivante
                Set Trouve = .FindNext(Trouve)
            Loop
        End If
    End With
End With
End Sub

Est ce mieux???
0
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
23 juil. 2014 à 15:18
Oui c'est mieux, je test ça et revient vers toi ;)
0
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
23 juil. 2014 à 17:33
Franck,
Je suis en train de recopier le code et je me demandais si le fait d'utiliser la même variable IndTbNouvo danhs la ligne 
If Tb_Nouvo(IndTbNouvo, Col) <> Tb_Ancien(mesRef_Ancien(Tb_Nouvo(IndTbNouvo, 1)), Col) Then
ne signifie pas que les références sont forcément placées à la même ligne ?
En effet, d'un tableau à un autre les références peuvent "changer" de ligne (selon que des références ait été ajoutées ou supprimées parmis les ligne du dessus).

Cordialement,
Ecrelinf
0
Ecrelinf Messages postés 36 Date d'inscription mercredi 12 mars 2014 Statut Membre Dernière intervention 26 février 2015
23 juil. 2014 à 18:07
Franck,

J'ai testé la macro et pour la ligne : 
ReDim Preserve Tb_Out(1 To j, 1 To 53)
le débogueur m'informe que "l'indice n'appartient pas à la sélection".

Bonne soirée.
Cordialement,
Ecrelinf
0

Discussions similaires

recherche à partir de la barre d'adresse
Sylviane -
Lulin -

11 réponses
ou sont les bananes ?
Liline -
Le Pro -

2 réponses
Colis en cours de transport vers votre site de livraison ?
Ninan_5568 -
senda -

8 réponses
exo pix
Xtyller -
Raymond PENTIER -

2 réponses
Bibliothèque
cosjac85 -
renard bleu -

3 réponses