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
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
A voir également:
- Rechercher des valeurs d'un tableau vers un autre
- Rechercher ou entrer l'adresse - Guide
- Tableau croisé dynamique - Guide
- Adresse IP locale : comment la trouver facilement - Guide
- Tableau ascii - Guide
- Tableau word - Guide
5 réponses
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
Modifié par pijaku le 24/07/2014 à 10:52
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 :
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
J'en ai profité pour corriger un petit bug dans le FindNext de la fin...
Ne t'inquiète pas pour :
ou pas...
On verra, c'est selon...
Des fois ça marrrrche et desw fois ça marrrche pas...
Cordialement,
Franck
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 ligneNormalement, c'est bon comme ça!
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 ?
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
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
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
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
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
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 :
Merci Michel.m ! Et bonne journée ;)
'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 ;)
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
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 :
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
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
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
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
https://forums.commentcamarche.net/forum/affich-30547876-comparer-deux-longues-lignes
Abandon du suivi sur ces 2 postS
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
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.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
23 juil. 2014 à 11:16
23 juil. 2014 à 11:16
mais je planche sur une autre macro actuellement, alors ne t'en va pas trop loinL'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...
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
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 :
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
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
23 juil. 2014 à 11:29
23 juil. 2014 à 11:29
Connais tu les variables tableau?
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
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.
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.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
Modifié par pijaku le 23/07/2014 à 12:30
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...
Code réalisé sans fichiers de test..... A voir donc
Cordialement,
Franck
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
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
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 !
En tout cas merci pour ta disponibilité Franck !
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
Modifié par pijaku le 23/07/2014 à 15:01
Modifié par pijaku le 23/07/2014 à 15:01
Non il s'agit d'un bug qui revient de temps à autre.....
Est ce mieux???
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???
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
23 juil. 2014 à 15:18
Oui c'est mieux, je test ça et revient vers toi ;)
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
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
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
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) Thenne 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
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
23 juil. 2014 à 18:07
Franck,
J'ai testé la macro et pour la ligne :
Bonne soirée.
Cordialement,
Ecrelinf
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
24 juil. 2014 à 09:51
Cependant il semblerait que le petit bug du code-qui-ne-veut-pas-s'afficher est revenu ... ^^
Bonne journée !
24 juil. 2014 à 10:52
24 juil. 2014 à 10:55
A vérifier.
28 juil. 2014 à 09:58
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
28 juil. 2014 à 10:19
Je viens d'essayer avec tes deux fichiers. Résultat des cellules coloriées en rouge, sans ¤.....