Forums Rue-Montgallet.com
Rue-Montgallet.comRue-Hardware.comRue-Occasion.comRue-DVD.comRue-Jeuxvideo.comRue-AudioVideo.comRue-Telephone.comForums
S'inscrire | S'identifier |
| Recherche avancée | Aide
 
 

Il y a 87 utilisateurs connus et inconnus. Pour voir la liste des connectés connus, cliquez ici
Sujet(s) à lire :
 

 Mot :   Pseudo :  
 
 Page :  1  2
Page Précédente 
Auteur
 Sujet :

Comparaison ligne/ligne Excel

 
n°16919
seb98800
Profil : Jeune recrue
Posté le 18-06-2006 à 01:09:34  profilanswer
 

Bonjour a toutes et à tous ,
 
J'ai trouver sur ce forum , une macro ecrit par Mr galopin01 qui est tres interressante .
http://forum.rue-montgallet.com/ru [...] 2582-1.htm
Vu que je debute en VB , je me demandais comment est ce qu'on peut pouvait indiquer quelles cellules etaient différentes dans le classeur B,en les coloriant en orange par exemples , celles qui sont supprimer en les rayant dans le classeur A, et les nouvelles en vert .
 
 
Merci pour votre aide
 
sébastien

n°16920
galopin01
Profil : Membre
Posté le 18-06-2006 à 08:02:47  profilanswer
 

Topikalacon !
 :D  
ça c'est une question trop vague.
En dehors de classeur A et classeur B on a rien.
 
On compare quoi avec quoi ? quelle colonne de quelle feuille avec quelle colonne de quelle feuille ?
Pour trouver des cellules nouvelles ou absentes celà suppose qu'on connait au moins les colonnes contenant le même type de données.
Pour trouver des cellules différentes celà suppose qu'on a au moins une colonne de références permettant d'identifier des enregistrements comparables.
Pour le reste format rouge ou orange ou vert ou caractère barré, il y a l'enregistreur de macro.
 
En résumé pour avoir une réponse précise on pose des questions précises !
Sur ce : Bon dimanche, je serai sur le stade toute la journée...
 
A+

n°16921
seb98800
Profil : Jeune recrue
Posté le 18-06-2006 à 10:05:04  profilanswer
 

Bonjour Galopin01,
 
Merci pour ton entete tres ......explicite !
Mais comme tu peux le voir , j'ai mis un lien qui renvoie sur le sujet de ce poste , en fait un autre post concernant ce sujet mais que je trouvais incomplet pour mon besoin.Et plutot que de passé inaperçu dans le forum vu la date de création du post reference j'ai prefere en faire un nouveaux .Peut etre ai je eu tort !
Donc je vais reedité la demande du post cité mais avec une demande plus explicite !(Si je peux ...et affiné a mes besoin)
J'ai deux classeur Excel que l'on va appele "Ancien" et "Nouveau". Ces deux fichiers sont similaires dans leurs structure (Meme type de renseignement par colone).Ils ont en colone de reference la colone A. Chaque valeur de cellule de la colone A est unique dans chaques fichiers.
En fait , chaque ligne a comme entête commun la cellule "An" qui est unique mais qui peut varié de positon dans la colonne A d'un fichiers a l'autre.
Ce que je souhaite , c'est que la macro éffectue la comparaison de la Celllule A1 du fichier "Ancien" avec toute les cellules de la colone A du fichiers "Nouveau" ainsi de suite .
-Si elle ne trouve pas la valeur recherche de A1 du fichier "Ancien" dans le fichier "nouveau", la macro raye la ligne dans le fichier "Ancien".
-Si elle trouve la valeur recherche de A1 du fichier "Ancien" dans le fichier "nouveau", elle réalise une comparaison de toute les cellules adjacente a cette cellule (B1 du classeur "Ancien" avec Bn du fichier "Nouveau"  jusqu'a O1).
  Dans ceux cas deux possibilié :
     -> Si la ligne est identique , la ligne devient verte dans le fichier "Nouveaux"
     -> Si il y a des difference , alors chaque cellule différentes devient orange dans le fichier "Nouveau" ainsi que la cellule en A.
Voilà , j'espere avoir été assez claire dans mes explications .
 
Merci
 
Seb
 
 
 
 

n°16924
galopin01
Profil : Membre
Posté le 18-06-2006 à 19:43:36  profilanswer
 

Combien de lignes dans ces fichiers quelques centaines ou plusieurs (dizaines de) milliers ?


Message édité par galopin01 le 18-06-2006 à 19:44:13
n°16925
galopin01
Profil : Membre
Posté le 18-06-2006 à 22:28:48  profilanswer
 

Bonsoir,
Comme je suppose qu'il est illusoire d'espérer une réponse pendant le match, je te l'ai fait pour des petits fichiers (moins de 30 000 lignes)
Comme je regarde le match en même temps j'ai simplifié un peu, pour pas trop fatiguer quand même !
Comme j'ai pas compris cette ligne :

Citation :

En fait , chaque ligne a comme entête commun la cellule "An" qui est unique mais qui peut varié de positon dans la colonne A d'un fichiers a l'autre.

...Je l'ai ignorée.
 
Les deux fichiers "Ancien" et "Nouveau" sont censés être déjà ouverts.
Donc, les références qui n'existent pas dans "Nouveau" je les ai mises en rouge dans "Ancien"
Les références semblables dans "Ancien" et "Nouveau" sont vertes.
S'il y a des différences sur des références identiques, les différences sont oranges.
Le code est suffisament commenté : je suppose que si tu as besoin de peindre toute la ligne ou de la rayer tu sauras te débrouiller.

Code :
  1. Sub galopin()
  2. Dim iLRA%, iLRN%, i%, j%, k%
  3. Dim Y As Boolean, Ys As Boolean
  4. Dim TabloA(), TabloN()
  5. Dim WbA As Workbook, WbN As Workbook
  6. Dim WsA As Worksheet, WsN As Worksheet
  7. 'Détermination du nombre de ligne de Classeur "Ancien" et "Nouveau"
  8. Set WbA = Workbooks("Ancien.xls" )
  9. Set WbN = Workbooks("Nouveau.xls" )
  10. Set WsA = WbA.Worksheets(1)
  11. Set WsN = WbN.Worksheets(1)
  12. iLRA = WsA.Cells(65535, 1).End(xlUp).Row
  13. iLRB = WsN.Cells(65535, 1).End(xlUp).Row
  14. TabloA() = WsA.Range("A1:A" & iLRA)
  15. TabloN() = WsN.Range("A1:A" & iLRB)
  16. 'Détermination des absents
  17. For i = 1 To UBound(TabloA)
  18.   For j = 1 To UBound(TabloN)
  19.     'Si égalité alors on pose un drapeau
  20.     If TabloN(j, 1) = TabloA(i, 1) Then
  21.       Y = True
  22.       'et on vérifie la ligne si c'est une égalité stricte
  23.         For k = 1 To 15
  24.           'si différence on pose un drapeau
  25.           If WsA.Cells(i, k) <> WsN.Cells(j, k) Then
  26.             Ys = True
  27.             'et on colore en orange
  28.             WsN.Cells(j, k).Interior.ColorIndex = 45
  29.           End If
  30.         Next
  31.           'sinon 1ere cellule en vert
  32.           If Not Ys Then WsN.Cells(j, 1).Interior.ColorIndex = 4
  33.         Ys = False
  34.       Exit For
  35.     End If
  36.   Next
  37.   'Si pas trouvé alors on colorie en rouge
  38.   If Not Y Then WsA.Range("A" & i).Interior.ColorIndex = 3
  39.   Y = False
  40. Next
  41. Set WbA = Nothing
  42. Set WbN = Nothing
  43. Set WsA = Nothing
  44. Set WsN = Nothing
  45. End Sub

Sans rancune !
A+

Message cité 1 fois
Message édité par galopin01 le 18-06-2006 à 23:01:11
n°16926
galopin01
Profil : Membre
Posté le 18-06-2006 à 22:54:00  profilanswer
 

PS : Comme il m'arrive de relire le sujet, je te donne une autre version pour la ligne 32 :

Code :
  1. WsN.Cells(j, 1).Interior.ColorIndex = IIf(Ys, 45, 4)

Je précise que je n'ai pas vérifié parce que j'ai déjà détruit mes fichiers test.
Cette ligne modifiée est censée mettre la première cellule en orange aussi (si d'autres cellules sont modifiées).
A+

n°16927
seb98800
Profil : Jeune recrue
Posté le 19-06-2006 à 01:40:31  profilanswer
 

Salut galopin01,
 
Je te remercie pour ta macro . Elle marche tres bien et m'est tres utile.
Ta derniere ne marche pas mais cela n'est pas trop grave car les autres cellules modifiées sont orange .
 
Pour le match , desolé , je ne suis pas tres foot , de plus ou je vis c'etait le debut de journée donc direction boulot !C'est pour çà que je n'ai pas repondu !
 
Merci encore pour ton aide qui m'a été précieuse !
 
Seb
 
 
 
 
 
 
 

n°16928
galopin01
Profil : Membre
Posté le 19-06-2006 à 07:42:33  profilanswer
 

bonjour,
comment ça ?  ça marche pas... Tu rigoles  :D  
Il fallait remplacer la ligne 32

Code :
  1. Sub galopin()
  2. Dim iLRA%, iLRN%, i%, j%, k%
  3. Dim Y As Boolean, Ys As Boolean
  4. Dim TabloA(), TabloN()
  5. Dim WbA As Workbook, WbN As Workbook
  6. Dim WsA As Worksheet, WsN As Worksheet
  7. 'Détermination du nombre de ligne de Classeur "Ancien" et "Nouveau"
  8. Set WbA = Workbooks("Ancien.xls" )
  9. Set WbN = Workbooks("Nouveau.xls" )
  10. Set WsA = WbA.Worksheets(1)
  11. Set WsN = WbN.Worksheets(1)
  12. iLRA = WsA.Cells(65535, 1).End(xlUp).Row
  13. iLRB = WsN.Cells(65535, 1).End(xlUp).Row
  14. TabloA() = WsA.Range("A1:A" & iLRA)
  15. TabloN() = WsN.Range("A1:A" & iLRB)
  16. 'Détermination des absents
  17. For i = 1 To UBound(TabloA)
  18.   For j = 1 To UBound(TabloN)
  19.     'Si égalité alors on pose un drapeau
  20.     If TabloN(j, 1) = TabloA(i, 1) Then
  21.       Y = True
  22.       'et on vérifie la ligne si c'est une égalité stricte
  23.         For k = 1 To 15
  24.           'si différence on pose un drapeau
  25.           If WsA.Cells(i, k) <> WsN.Cells(j, k) Then
  26.             Ys = True
  27.             'et on colore en orange
  28.             WsN.Cells(j, k).Interior.ColorIndex = 45
  29.           End If
  30.         Next
  31.           'sinon 1ere cellule en vert
  32.           WsN.Cells(j, 1).Interior.ColorIndex = IIf(Ys, 45, 4)
  33.         Ys = False
  34.       Exit For
  35.     End If
  36.   Next
  37.   'Si pas trouvé alors on colorie en rouge
  38.   If Not Y Then WsA.Range("A" & i).Interior.ColorIndex = 3
  39.   Y = False
  40. Next
  41. Set WbA = Nothing
  42. Set WbN = Nothing
  43. Set WsA = Nothing
  44. Set WsN = Nothing
  45. End Sub

Non mais !
 
A+

n°18686
Kevin66
Profil : Jeune recrue
Posté le 15-06-2007 à 13:30:08  profilanswer
 

Désolé de sortir ce message du fin fond du forum mais je suis tombé sur ca grace a google. Sa fait exactement ce que je veux faire à une seul différence pret.
 
J'aimerais plutot utiliser ce script pour faire la comparaison entre 2 feuilles dans un même fichier excel et non la comparaison entre deux fichier excel distinct.
Aussi j'aimerais mettre le text qui est sur fond rouge en blanc au lieu de noir...
 
Quelqu'un peut m'aider ? J'ai jamais fais de VBA de ma vie, c'est la première fois.
 
J'ai réussi a faire fonctionner le script donc il faudrait seulement que je sache comment comparer deux feuilles
 
Merci
 
J'ai modifier un peu le fichier pour changer les options de couleur. Si vous voyer des problème potentiel faite s'en part :D Merci
 

Code :
  1. Sub Comparaison()
  2. Dim iLRA%, iLRN%, i%, j%, k%
  3. Dim Y As Boolean, Ys As Boolean
  4. Dim TabloA(), TabloN()
  5. Dim WbA As Workbook, WbN As Workbook
  6. Dim WsA As Worksheet, WsN As Worksheet
  7. 'Détermination du nombre de ligne de Classeur "Ancien" et "Nouveau"
  8. Set WbA = Workbooks("Perdu.xls" )
  9. Set WbN = Workbooks("Retrouvé.xls" )
  10. Set WsA = WbA.Worksheets(1)
  11. Set WsN = WbN.Worksheets(1)
  12. iLRA = WsA.Cells(65535, 1).End(xlUp).Row
  13. iLRB = WsN.Cells(65535, 1).End(xlUp).Row
  14. TabloA() = WsA.Range("A1:A" & iLRA)
  15. TabloN() = WsN.Range("A1:A" & iLRB)
  16. 'Détermination des absents
  17. For i = 1 To UBound(TabloA)
  18.   For j = 1 To UBound(TabloN)
  19.     'Si égalité alors on pose un drapeau
  20.     If TabloN(j, 1) = TabloA(i, 1) Then
  21.       Y = True
  22.       'et on vérifie la ligne si c'est une égalité stricte
  23.         For k = 1 To 15
  24.           'si différence on pose un drapeau
  25.           If WsA.Cells(i, k) <> WsN.Cells(j, k) Then
  26.             Ys = True
  27.             'et on colore en orange
  28.             WsN.Cells(j, k).Interior.ColorIndex = 45
  29.             WsA.Cells(i, k).Interior.ColorIndex = 45
  30.           End If
  31.         Next
  32.           'sinon 1ere cellule en vert
  33.           WsN.Cells(j, 1).Interior.ColorIndex = IIf(Ys, 45, 4)
  34.           WsA.Cells(i, 1).Interior.ColorIndex = IIf(Ys, 45, 4)
  35.         Ys = False
  36.       Exit For
  37.     End If
  38.   Next
  39.   'Si pas trouvé alors on colorie en rouge
  40.   If Not Y Then WsA.Range("A" & i).Interior.ColorIndex = 3
  41.   Y = False
  42. Next
  43. Set WbA = Nothing
  44. Set WbN = Nothing
  45. Set WsA = Nothing
  46. Set WsN = Nothing
  47. End Sub


Message édité par Kevin66 le 15-06-2007 à 13:31:16
n°18689
galopin01
Profil : Membre
Posté le 15-06-2007 à 21:31:54  profilanswer
 

bonsoir,
Le programmeur est une espèce assez stressée et débordée qui déteste se compliquer la vie quand on peut faire simple...
Et le plus simple ça serait quand même de te faire un nouveau classeur temporaire avec une copie de ta deuxième feuille !
ClicDroit sur l'onglet + Déplacer ou copier (Cocher Faire une copie)...
A moins d'avoir 500 feuilles à comparer c'est cool !
A+


---------------
Je ne répondrai pas aux messages privés non sollicités. Merci de poser vos questions sur le forum.
n°18690
galopin01
Profil : Membre
Posté le 15-06-2007 à 21:39:47  profilanswer
 

Tu peux aussi considérer ton classeur unique comme deux classeurs différents...
Imaginons que tu veuilles comparer
dans MonClasseurUnique.xls la feuille "source" avec la feuille "cible", ça donne :

Code :
  1. Sub galopin()
  2. Dim iLRA%, iLRN%, i%, j%, k%
  3. Dim Y As Boolean, Ys As Boolean
  4. Dim TabloA(), TabloN()
  5. Dim WbA As Workbook, WbN As Workbook
  6. Dim WsA As Worksheet, WsN As Worksheet
  7. 'Détermination du nombre de ligne de Classeur "Ancien" et "Nouveau"
  8. Set WbA = Workbooks("MonClasseurUnique.xls" )
  9. Set WbN = Workbooks("MonClasseurUnique.xls" )
  10. Set WsA = WbA.Worksheets("source" )
  11. Set WsN = WbN.Worksheets("cible" )


...La suite sans changement.
 
A+


Message édité par galopin01 le 15-06-2007 à 21:40:02

---------------
Je ne répondrai pas aux messages privés non sollicités. Merci de poser vos questions sur le forum.
n°18727
Bouldu
Profil : Jeune recrue
Posté le 25-06-2007 à 12:18:31  profilanswer
 

Bonjour Galopin01,
 
J'ai trouvé sur le forum cette macro qui correspond à ce que je recherche depuis un certains temps.
Et je travail également en comptabilité et je me suis lancé depuis peu sur VB afin d'essayer (modestement) d'optimiser des tâches récurrentes de vérification.
 
Cependant je ne suis pas un expert en VB et je n'arrive pas à modifier la macro pour effectuer la recherche non pas sur un nombre de caractère spécifique (a = x) mais sur chaque mot de la DB2.
 
J'aimerai également pourvoir indiquer en colonne E sur la feuille DB1 le numéro de la ligne sur laquelle l'occurence a été trouvé dans la feuille DB2.
 
Si cela peut aider j'ai un fichier test qui sera sans nul doute plus explicite que mes vagues explications.
 
Merci d'avance pour ton aide.
 
 
1. Sub Test(b As Byte)
2. Dim a As Byte, iLR1%, iLR2%, i%, j%, k%, x%, z$, iL%, iT%
3. Dim S As String, ZExTStr$, Tablo, Y As Boolean
4. 'Gèle l'écran pour accélérer le traitement
5. Application.ScreenUpdating = False
6. 'Détermination de la dernière ligne de chaque feuille
7. iLR1 = Worksheets("DB1" ).Cells(65535, b).End(xlUp).Row
8. iLR2 = Worksheets("DB2" ).Cells(65535, 2).End(xlUp).Row
9. 'Charge en mémoire les valeurs de DB2
10. Tablo = Worksheets("DB2" ).Range("c2:h" & iLR2)
11. With Worksheets("DB1" )
12. 'Colorie toute les cellules en rouge
13. .Range(Cells(1, b), Cells(iLR1, b)).Interior.ColorIndex = 3
14. 'Pour chaque ligne dans DB1
15. a = 4           'Dimensionne la longueur de la chaine de recherche
16. For i = 1 To iLR1
17. 'Mémorise la valeur de la cellule
18. z = .Cells(i, b).Value
19. iL = Len(z) + 1
20.   'recherche de chaîne de longueur a dans z
21.   For x = 1 To iL - a
22.     'sur quatre colonnes
23.     For k = 1 To 4
24.       'parcourt le Tablo
25.       For j = 1 To UBound(Tablo)
26.       'Scanne toutes les possibilités de chaine selon la longueur de z
27.       ZExTStr = Mid(z, x, a)
28.         'Teste la chaîne trouvée
29.         If InStr(1, Tablo(j, k), ZExTStr) > 0 Then
30.         S = Tablo(j, k)
31.         Init_SMBox z, x, a, S
32.         DialogSheets("SMBox" ).Show
33.           If iRet > 2 Then
34.             Y = True
35.             Exit For
36.           ElseIf iRet = 2 Then
37.             'If x < iL - a Then x = x + 1
38.             k = 4
39.             iRet = 0
40.             Exit For
41.           ElseIf iRet = 1 Then
42.             Worksheets("DB1" ).Activate
43.             End
44.           End If
45.         End If
46.       Next
47.     If Y Then Exit For
48.     Next
49.   's'il y a un drapeau décolore la cellule
50.   If Y Then
51.   If iRet = 4 Then .Cells(i, b).Interior.ColorIndex = xlColorIndexNone
52.   iRet = 0
53.   'remet le drapeau à Faux
54.   Y = False
55.   'et arrête l'examen du tableau
56.   Exit For
57.   End If
58.   Next
59. 'recommence sur les valeurs suivantes de DB1
60. Next
61. End With
62. Application.ScreenUpdating = True
63. Worksheets("DB1" ).Activate
64. End Sub


Message édité par Bouldu le 25-06-2007 à 12:31:07
n°18730
galopin01
Profil : Membre
Posté le 25-06-2007 à 17:16:57  profilanswer
 

Bonjour,
Envoie ton fichier test que je jette un oeil.
A+


---------------
Je ne répondrai pas aux messages privés non sollicités. Merci de poser vos questions sur le forum.
n°18731
Bouldu
Profil : Jeune recrue
Posté le 25-06-2007 à 17:53:48  profilanswer
 

Bonjour Galopin01,
 
Je suis novice sur le forum et je n'ai pas trouvé la manip pour attaché un fichier.  
 
Dois-je te l'envoyer par mail?
 
Merci mille fois pour ton aide.
 
A+

n°18732
galopin01
Profil : Membre
Posté le 25-06-2007 à 18:17:08  profilanswer
 

Upload ton fichier sur cjoint et communique nous le lien qui te sera donné.
A+


Message édité par galopin01 le 25-06-2007 à 18:19:27

---------------
Je ne répondrai pas aux messages privés non sollicités. Merci de poser vos questions sur le forum.
n°18733
Bouldu
Profil : Jeune recrue
Posté le 25-06-2007 à 18:34:58  profilanswer
 

Voici le lien du fichier exemple: http://cjoint.com/?gzszCxnOCl
 
Comme tu pourras le voir, j'ai ajouter une fonction qui me permet de faire un trie sur le code couleur.
L'objectif étant d'identifier les mots en communs de la liste DB1 (référence) par rapport à la liste DB2 qui elle est variable.
 
C'est une macro assez tordu car certains mots comme tu peux le voir sont récurents et absolument pas pertinents dans la recherche. Il y a évidemmenent les conjonctions (of, and, or...) ainsi que certains mots génériques comme "International", "National, "Bank"....
 
L'idéal (mais je ne sais pas si cela est facilement réalisable) serait de pourvoir saisir une liste de mot sur lesquels la recherche ne doit pas s'éfectuer.
 
Voilà et encore merci pour ton aide. De mon côté j'essaye également d'avancer sur la question, mais je te cache pas que vu la complexité de la chose, j'avance à petits pas.

n°18736
galopin01
Profil : Membre
Posté le 25-06-2007 à 21:48:30  profilanswer
 

Bonsoir,
Voici une solution qui correspond à peu près à ce que tu as demandé.
Pour chaque occurence par exemple NATIONAL BANK le prog renvoie en colonne F un string contenant le premier mot et les N° des lignes trouvées; en colonne G le deuxième mot et les N° des lignes trouvées; en colonne H le troisième mot... et ainsi de suite.
NATIONAL 22 57 128 244 / BANK 2 4 6 8 122 151 315...
Quand un mot n'a pas été trouvé la colonne reste vide.
Nota : la procédure ne s'applique qu'aux mots d'au moins 2 lettres.
Nota2 : Il a été nécessaire de faire un pré-nettoyage car des espaces multiples entravaient le bon déroulement de la macro. Des espaces de fin et de début indésirables ont été laissés bien qu'ils entravent également le fonctionnement mais une solution de contournement (avec Trim) à été utilisée.
Le code est abondament commenté... mais si tu as besoin tu en redemandes !
A+


---------------
Je ne répondrai pas aux messages privés non sollicités. Merci de poser vos questions sur le forum.
n°18737
Bouldu
Profil : Jeune recrue
Posté le 25-06-2007 à 22:26:57  profilanswer
 

Bonsoir,
 
Merci pour la solution. Je regarde tout ça ce soir et je te dis si j'ai des questions.
 
Merci mille fois pour ton aide précieuse.
 
A+

n°18740
Bouldu
Profil : Jeune recrue
Posté le 26-06-2007 à 16:38:19  profilanswer
 

Bonjour Galopin01,
 
C'est super et j'ai quasiment une macro exploitable. Juste un point sur lequel tu as peut être une idée.
Il y a des mots qui se retrouve régulièrement dans la liste de référence (DB2) et qui ne sont pas pertinents pour la comparaison. Est-il possible de restreindre la comparaison sur certains mots?
 
Le but de la manip étant de n'avoir que des occurences pertinentes qui permettront à l'utilisateur de pourvoir ensuite informer l'unité ( colonne A & B) des clients trouvés en DB1 dans la base de référence en DB2 afin qu'il puisse faciliment les identifier et les reclasser.
 
Il y aura donc de la manip manuelle puisqu'il faudra indiquer à l'utilisateur la correspondance dans DB2 (au moins le code client CLIENT=D...)
 
Je ne sais pas si je suis claire, si ce n'est pas le cas fais le moi savoir et j'essayerai d'être plus explicite.
 
Merci encore pour tes précieux conseils et travaux.
 
A+

n°18741
galopin01
Profil : Membre
Posté le 26-06-2007 à 18:11:02  profilanswer
 

bonjour,
j'ai remanié pas mal le code pour conserver une vitesse d'exécution satisfaisante...
Voila le résultat
J'ai rajouté une fonction  qui permettra de modifier facilement les critères d'exclusion :
Dans cette fonction actuellement les mots "LINE BANK NS MAX PHARMA DE AG CR AIR" sont exclus.

Code :
  1. Function Exclu(S As String) as Boolean
  2. Dim b As Byte,Tablo$(), Y As Boolean
  3. Tablo() = Split("LINE BANK NS MAX PHARMA DE AG CR AIR" )
  4. For b = 0 To UBound(Tablo)
  5. If S = Tablo(b) Then Y = True
  6. Next
  7. Exclu = Y
  8. End Function


On peut en rajouter autant que nécessaire pour peu qu'il y ait toujours un seul espace entre chaque mot et pas d'espace au début ni à la fin de la chaine.
 
A+


---------------
Je ne répondrai pas aux messages privés non sollicités. Merci de poser vos questions sur le forum.
n°18742
Bouldu
Profil : Jeune recrue
Posté le 26-06-2007 à 22:29:56  profilanswer
 

Bonsoir Galopin,
 
C'est super et exactement ce dont j'avais besoin. Je suis maintenant en train de plancher sur une solution pour trouver une façon de trier les n° de ligne ou des occurences apparaissent.
 
Je m'explique: si on prend l'exemple de la 1ère ligne "CANCER RESEARCH", la macro de comparaison renvoie pour le mot "RESEARCH" aux lignes 960 & 2233. Et pour le 2nd mot "RESEARCH" elle renvoie aux lignes 960 & 2586. Dans cette exemple la ligne 960 apparait pour les 2 mots composants le nom du client comparé. L'idée serait de construire une macro annexe qui compare les valeurs retournées par la macro d'origine entre les différents mots et s'il trouve au moins 2 fois la même ligne référence de l'inscrire sur la celulle qui suit afin de pouvoir clairement identifier le client.
 
Le but étant maintenant de traiter le problème en reserrant l'échantillon.
 
J'ai trouvé une macro qui découpe une cellule selon les espaces mais je ne suis pas super calé pour les mémoriser et les comparer avec d'autres tableaux qui comporteraient la cellule suivante également découpé mot à mot.
 
Si tu as une idée, elle serait bienvenue.
 
 
Merci encore pour tous le temps passé.
 
A+

n°18743
galopin01
Profil : Membre
Posté le 27-06-2007 à 03:41:23  profilanswer
 

Désolé je ne comprend pas la question.
Ouvre un autre sujet, car celui-ci va devenir un squat incompréhensible et joint y un nouveau fichier explicatif.
A+


---------------
Je ne répondrai pas aux messages privés non sollicités. Merci de poser vos questions sur le forum.
n°18754
Bouldu
Profil : Jeune recrue
Posté le 28-06-2007 à 10:52:28  profilanswer
 

Bonjour Galopin,
 
J'ai créé un nouveau sujet en espèrant que cela sera plus clair.
 
http://forum.rue-montgallet.com/ru [...] 3403_1.htm
 
Merci pour ton aide.
 
A+

n°19062
Galatee
Profil : Jeune recrue
Posté le 22-11-2007 à 15:38:49  profilanswer
 

Bonjour Galopin01,
 
je dois t'avouer que je trouve super que tu aides ainsi les gens en ligne. Tu dois vraiment être passioné de programmation pour y consacrer tant de temps. Moi je ny capte que tres peu de chose. Jai lu tous les messages sur la comparaison de lignes pour identifier les doublons mais je narrive pas à lappliquer à mon cas.  
 
En fait, j'ai une seule feuille excel qui est le resultat d'extraction de données brute avec une mise en forme par macro. et je dois analyser les resultats. Malheureusement, j'ai des milliers de lignes et c'est très fastidieux d identifier les lignes dupliquees et de les supprimer. En resumé, j'ai une feuille excel de 45 colonnes avec des milliers de lignes et il faudrait que ma macro verifie si la première ligne a une ligne doublon (c'est à dire vérifier l'intégralite des 45 cellules d'une ligne) et ensuite passer à la seconde et ainsi de suite. Lorsqu'elle rencontre un doublon il faudrait que la macro le supprime.
 
voilà jespère queje me suis bien exprimée et j'espère que tu pourras maider.
 
A bientot
 
Galatée

n°19063
galopin01
Profil : Membre
Posté le 23-11-2007 à 02:09:00  profilanswer
 

bonjour,
Tu peux tester ce code qui devrait convenir à condition que la dernière cellule de la colonne 1 ne soit pas vide.

Code :
  1. Sub test()
  2. Dim i&, j&, k&, ii%, iLC%, jLC%, Arr(), Y As Boolean
  3. ReDim Preserve Arr(1)
  4. 'recherche de la dernière ligne non vide (1ère colonne)
  5. iLR = Cells(65536, 1).End(xlUp).Row
  6. 'de la dernière ligne à la première
  7.   For i = iLR To 1 Step -1
  8.   j = 1: k = 1
  9.     Do While j < i
  10.       'si 2 cellules de la première colonne sont identique...
  11.       If Cells(i, k) = Cells(i - j, k) Then
  12.       Y = True
  13.       'recherche de la dernière colonne non vide
  14.         iLC = Cells(i, 256).End(xlToLeft).Column + 1
  15.         Do While Y
  16.           'dans chaque colonne on cherche une différence
  17.           For ii = 2 To iLC
  18.             If Cells(i, ii) <> Cells(i - j, ii) Then
  19.               Y = False
  20.               Exit Do
  21.             End If
  22.             'vérification
  23.             If ii = iLC Then
  24.               jLC = Cells(i - j, 256).End(xlToLeft).Column + 1
  25.               If jLC > iLC Then Y = False
  26.               Exit Do
  27.             End If
  28.           Next
  29.         Loop
  30.         'Si on n'a pas trouvé de différence alors on stocke la ligne trouvée dans un Array
  31.         If Y Then
  32.         Arr(UBound(Arr)) = (i)
  33.         ReDim Preserve Arr(UBound(Arr) + 1)
  34.         Exit Do
  35.         End If
  36.       End If
  37.       j = j + 1
  38.     Loop
  39.   Next
  40. 'On supprime toutes les lignes enregistrées
  41. For i = 1 To UBound(Arr) - 1
  42.   Rows(Arr(i)).Delete
  43. Next
  44. End Sub


A+


Message édité par galopin01 le 28-11-2007 à 16:29:33
n°19095
Galatee
Profil : Jeune recrue
Posté le 28-11-2007 à 13:59:01  profilanswer
 

Bonjour Galopin,
 
j'ai testé ton code ces derniers jours mais je nai pas réussi à le faire marcher. :-(. En fait, il trouve bien la dernière ligne non vide et se déplace bien dans les cellules sauf lorsqu il renconter des cellules vides. J'ai mis un espion dans la macro pour pouvoir suivra pas à pas les valeurs des variables et je me suis rendue compte que lorsque les cellules étaient vides 'j' revient à la première cellule de la ligne. Et malheureusement, les cellules vides sont assez fréquentes. est ce que tu as une idée?
Merci
 

n°19096
galopin01
Profil : Membre
Posté le 28-11-2007 à 16:28:57  profilanswer
 

Bonjour,
Effectivement j'ai du rajouter une variable et une boucle de contrôle.
Reprendre le code ci-dessus modifié.
A+


---------------
Je ne répondrai pas aux messages privés non sollicités. Merci de poser vos questions sur le forum.
n°19237
Aurel312
Profil : Jeune recrue
Posté le 07-04-2008 à 15:06:19  profilanswer
 

galopin01 a écrit :

Bonsoir,
Comme je suppose qu'il est illusoire d'espérer une réponse pendant le match, je te l'ai fait pour des petits fichiers (moins de 30 000 lignes)
Comme je regarde le match en même temps j'ai simplifié un peu, pour pas trop fatiguer quand même !
Comme j'ai pas compris cette ligne :

Citation :

En fait , chaque ligne a comme entête commun la cellule "An" qui est unique mais qui peut varié de positon dans la colonne A d'un fichiers a l'autre.

...Je l'ai ignorée.
 
Les deux fichiers "Ancien" et "Nouveau" sont censés être déjà ouverts.
Donc, les références qui n'existent pas dans "Nouveau" je les ai mises en rouge dans "Ancien"
Les références semblables dans "Ancien" et "Nouveau" sont vertes.
S'il y a des différences sur des références identiques, les différences sont oranges.
Le code est suffisament commenté : je suppose que si tu as besoin de peindre toute la ligne ou de la rayer tu sauras te débrouiller.

Code :
  1. Sub galopin()
  2. Dim iLRA%, iLRN%, i%, j%, k%
  3. Dim Y As Boolean, Ys As Boolean
  4. Dim TabloA(), TabloN()
  5. Dim WbA As Workbook, WbN As Workbook
  6. Dim WsA As Worksheet, WsN As Worksheet
  7. 'Détermination du nombre de ligne de Classeur "Ancien" et "Nouveau"
  8. Set WbA = Workbooks("Ancien.xls" )
  9. Set WbN = Workbooks("Nouveau.xls" )
  10. Set WsA = WbA.Worksheets(1)
  11. Set WsN = WbN.Worksheets(1)
  12. iLRA = WsA.Cells(65535, 1).End(xlUp).Row
  13. iLRB = WsN.Cells(65535, 1).End(xlUp).Row
  14. TabloA() = WsA.Range("A1:A" & iLRA)
  15. TabloN() = WsN.Range("A1:A" & iLRB)
  16. 'Détermination des absents
  17. For i = 1 To UBound(TabloA)
  18.   For j = 1 To UBound(TabloN)
  19.     'Si égalité alors on pose un drapeau
  20.     If TabloN(j, 1) = TabloA(i, 1) Then
  21.       Y = True
  22.       'et on vérifie la ligne si c'est une égalité stricte
  23.         For k = 1 To 15
  24.           'si différence on pose un drapeau
  25.           If WsA.Cells(i, k) <> WsN.Cells(j, k) Then
  26.             Ys = True
  27.             'et on colore en orange
  28.             WsN.Cells(j, k).Interior.ColorIndex = 45
  29.           End If
  30.         Next
  31.           'sinon 1ere cellule en vert
  32.           If Not Ys Then WsN.Cells(j, 1).Interior.ColorIndex = 4
  33.         Ys = False
  34.       Exit For
  35.     End If
  36.   Next
  37.   'Si pas trouvé alors on colorie en rouge
  38.   If Not Y Then WsA.Range("A" & i).Interior.ColorIndex = 3
  39.   Y = False
  40. Next
  41. Set WbA = Nothing
  42. Set WbN = Nothing
  43. Set WsA = Nothing
  44. Set WsN = Nothing
  45. End Sub

Sans rancune !
A+


 
Merci pour ce code qui marche tres bien  
cependant il me manque juste un parametre pour qu'il soit complet  
en effet dans le Fichier "Nouveau.xls" lorsque une nouvelle reference apparait qui n'existe pas dans "Ancien.xls" , je voudrais les flagger d'une couleur rouge par exemple  
Merci pour ton aide  
a+
 

n°19248
galopin01
Profil : Membre
Posté le 12-04-2008 à 01:27:37  profilanswer
 

bonjour,
Euh... probablement une erreur de plume.  
Je n'ai pas tout re-testé mais essaye voir de modifier ligne 38 :
  If Not Y Then WsN.Range("A" & i).Interior.ColorIndex = 3
 
Je le sens bien !
A+

n°19256
Aurel312
Profil : Jeune recrue
Posté le 16-04-2008 à 12:05:32  profilanswer
 

Et non marche pas ...  
 
J ai essayé cela aussi :  
 If Not Y Then WsN.Range("A" & j).Interior.ColorIndex = 3  
 
 
marche pas non plus . je peux eventuellement te passer les fichiers resultats ?

 Page :  1  2
Page Précédente 

Aller à :
Ajouter une réponse