[VA-E] trier des données avec macro VBA

Version imprimable

bonjour

voilà mon soucis est le suivant :

j'ai deux classeurs Excel contenant chacun 4 colonnes

je dois comparer ses deux classeurs (qui sont dans deux fichiers différents) pour afficher le résultats dans un nouveau classeur.

Ce classeur résultat devant contenir trois feuilles :
une pour les ajouts, une pour les modifications et une une pour les suppression.
chacune de ces trois feuilles de résultats reprenant les 4 colonnes de départ.

tout cela devrait etre lancé dans une macro Excel de façon simple pour l'utilisateur.

En gros j'ai jusqu'à la fin de la semaine.

Voilà maintenant j'ai ça comme script :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 Sub ComparaisonTableau() Dim RG1 As Range, RG2 As Range Dim Tblo1, Tblo2, Rg3 As Range Dim A As Long, B As Integer, C As Long, D As Integer Set RG1 = Sheets("Feuil1").Range("A1:A10") 'Tabeau 1 Set RG2 = Sheets("Feuil2").Range("A1:A10") 'Tableau 2 Set Rg3 = Sheets("Feuil3").Range("A1") 'Tableau des résultats If RG1.Rows.Count <> RG2.Rows.Count Then MsgBox "Le tableau n'a pas le même nombre de lignes" Exit Sub End If If RG1.Columns.Count <> RG2.Columns.Count Then MsgBox "Le tableau n'a pas le même nombre de colonnes" Exit Sub End If Tblo1 = RG1: Tblo2 = RG2: D = 1 Application.ScreenUpdating = False For A = 1 To UBound(Tblo1, 1) For B = 1 To UBound(Tblo1, 2) If Tblo1(A, B) <> Tblo2(A, B) Then C = C + 1 Rg3(C, D) = RG1(A, B).Address(0, 0) Rg3(C, D).Offset(, 1) = Tblo1(A, B) Rg3(C, D).Offset(, 2) = RG2(A, B).Address(0, 0) Rg3(C, D).Offset(, 3) = Tblo2(A, B) End If Next Next Set RG1 = Nothing: Set RG2 = Nothing: Set Rg3 = Nothing Erase Tblo1: Erase Tblo2 End Sub
le probleme de celui ci c'est qu'il ne permet de faire des comparaison qu'entre deux feuilles et pas deux classeur et que je ne peut pas lui faire un filtre sur des termes précis, de plus j'aurai souhaité avoir un classeur résultats contenant trois feuilles :

_ une pour les modif
_ une pour les ajouts
_ une pour les supression

conaîtriez vous un script qui puisse me faire (ou qui s'en rapproche) ?
ou éventuellement des astuces pour créer ce script ?

PS : j'ai déjà trouvé des progs qui font à peu pres ça mais ça me donne jamais ce que je veut (Diff Doc, Excel Compare ...)

Bonsoir

Tu devrais travailler avec des objets WorkBook. De plus, point n'est besoin de passer par des tableaux, tu peux directement comparer tes feuilles.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
Sub Comparer()
    Dim wk1 As Workbook ' Classeur 1
    Dim wk2 As Workbook ' Classeur 2
    Dim wk3 As Workbook ' Classeur de résultat
 
    Dim Plage1 As Range ' Plage du classeur1
    Dim Plage2 As Range ' Plage du classeur 2
 
    Dim Ligne As Long, Colonne As Integer ' Positionnement de la cellule dans la plage
 
    Set wk1 = Workbooks("Comparaison1.xls")
    Set wk2 = Workbooks("Comparaison2.xls")
    Set wk3 = Workbooks("resultatcomparaison.xls")
 
    Set Plage1 = wk1.Worksheets("feuil1").Range("a1:a10")
    Set Plage2 = wk2.Worksheets("feuil1").Range("a1:a10")
 
    For Ligne = 1 To Plage1.Rows.Count ' on itère sur le lignes DE LA PLAGE
        For Colonne = 1 To Plage1.Columns.Count ' et sur les colonnes DE LA PLAGE
            If Plage1.Cells(Ligne, Colonne) <> Plage2.Cells(Ligne, Colonne) Then
                MsgBox "Différence sur la cellule " & Plage1.Cells(Ligne, Colonne).Address ' Affichage si <>
            End If
        Next Colonne
    Next Ligne
 
    Set Plage1 = Nothing
    Set Plage2 = Nothing
    Set plage3 = Nothing
End Sub

Il reste à remplacer la ligne de message par le code affectant le classeur de résultat, mais je n'ai pas compris ce que tu souhaitais obtenir, ni ce que tu entendais par "ajouts, modifications et suppressions"

11/01/2007, 03h02
M@XflY

en gros

je voudrai que dans un classeur Excel qui serait le fichier résultat j'ai trois feuilles Excel

_ une m'indiquant toute les lignes qui ont été ajouté dans les différentes colonnes
_ une m'indiquant toute les lignes qui ont été suprimé
_ une m'indiquant tout les ligne qui ont été ajouté
11/01/2007, 10h50
M@XflY

je vais peut etre posé une question débile :

mais les macro VB pour Excel on peut les faire avec VB Express gratuit ou faut passer par VB 6 ?
11/01/2007, 10h52
Pierre Fauconnier

Citation:

Envoyé par M@XflY

en gros

je voudrai que dans un classeur Excel qui serait le fichier résultat j'ai trois feuilles Excel

_ une m'indiquant toute les lignes qui ont été ajouté dans les différentes colonnes
_ une m'indiquant toute les lignes qui ont été suprimé
_ une m'indiquant tout les ligne qui ont été ajouté

Le tout est de savoir comment déterminer les lignes ajoutées. Ajoutées ou supprimées par rapport à quoi? Par rapport à ta feuille récapitulative qui contiendrait déjà des données?

Peux-tu donner un petit exemple? Une liste avec 3 ou 4 données, une deuxième avec quelques données et une troisième avec ce que tu souhaites obtenir comme résultat?
11/01/2007, 11h05
M@XflY

bon en gros tu as deux enregistrement de fichiers Excel identique séparé d'un mois d'équart, l'un étant la mise à jouir de l'autre (par exemple un fichier pour janvier l'autre pour février) :

il contiennent chacun quatre colonnes :

Marque / Modèle / Code TAC / Bearer

il s'agit ici de telephones portable
le Code Tac est une suite de chiffre, le Bearer c'est la technologie utilisé (
2G, 3G ...)

et donc en gros je souhaite comparer ses deux fichiers qui sont sur la meme base (nom des colonnes et nombre identique) et sortir un troisième tableur.

Et dans ce tableur tu aura trois feuille Excel :
_ une indiquant les changements effectué dans les quatres colonne entre les deux classeurs Excel
_ une indiquant les ajouts qui ont été fait de portable (avec Marque, Modele ...) entre les deux enregistrement
_ et une derniere indiquant les suppression qui aurait été fait d'un mois sur l'autre

voilà

je travaille sur ton script, merci pour le tuyau si tu as d'autre suggestion

PS : par contre je voudrai savoir :
les macro VB pour Excel on peut les faire avec VB Express gratuit ou faut passer par VB 6 ?
car je vois pas trop ou je cole ton script et comment je le test ?
11/01/2007, 11h40
M@XflY

bon j'ai essayé ton script mais il me renvoie une erreur
en gros pour la sélection du deuxieme workbook il me dit que l'indice n'appartient pas à la sélection

en gros je pense qu'il ne trouve pas le fichier

je vais essayé de debugger pour voir
11/01/2007, 11h41
Pierre Fauconnier

Citation:

Envoyé par M@XflY

...
PS : par contre je voudrai savoir :
les macro VB pour Excel on peut les faire avec VB Express gratuit ou faut passer par VB 6 ?
car je vois pas trop ou je cole ton script et comment je le test ?

Le plus simple est de créer les macros dans le classeur Excel. Alt+F11 ou Outils/Macros/Visual Basic Editor pour entrer dans l'éditeur de VBA.

Pour ce qui est du code de comparaison proprement dit, je regarde et te dis quoi...
11/01/2007, 11h46
M@XflY

ok merci pour l'info c'est ce que j'étais en train de faire (pas reveiller ce matin)

pour l'instant j'essaye de trouver où est l'erreur qu'il me détecte

c'est la ligne :

Code:

Set wk2 = Workbooks("Comparaison2.xls")

là je lui indique l'emplacement exacte du tableur à comparer et je vois pas pourquoi il m'envoie bouller.

------------------------

bon ce bug est réglé maintenant il me sort le meme mais sur la ligne d'apres

on redebugg
11/01/2007, 11h54
Pierre Fauconnier

hmmm. J'ai du mal à te suivre

Pour la comparaison, l'idée est de déterminer des objets de type Range avec les plages du mois précédent et du mois en cours.

Puis, on utilise un truc du genre
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub RechercheElements(PlageBase As Range, PlageRecherche As Range) Dim Cellule As Range Dim CelResultat As Range For Each Cellule In PlageBase Set CelResultat = PlageRecherche.Find(what:=Cellule.Value, LookIn:=xlValues, lookat:=xlWhole) If CelResultat Is Nothing Then MsgBox Cellule.Value & " non trouvé" Next Cellule End Sub Sub Comparaison() Dim rngMoisPrecedent As Range Dim rngMoisEnCours As Range Set rngMoisPrecedent = Feuil1.Range("a2:a10") Set rngMoisEnCours = Feuil2.Range("a2:a10") RechercheElements rngMoisPrecedent, rngMoisEnCours ' recherche des suppressions RechercheElements rngMoisEnCours, rngMoisPrecedent ' recherche des ajout => inversion des plages End Sub
On démarre la procédure Comparaison en définissant les deux plages, puis on passe à RechercheElements en passant les deux plages en paramètres. Remarque que c'est la même procédure pour repérer les suppressions ou les ajouts. Seul l'ordre des paramètres est inversé.

Il faut bien entendu adapter à ton cas, notamment dans la restitution sur une troisième feuille des résultats

11/01/2007, 12h12
M@XflY

en fait je suis en train de tester la macro que tu m'as filé et ça me génère une erreur :

quand je lance la macro il me sort :
erreur d'excecution 9
l'indice n'appartient pas à la sélection

et il s'arrete là dessus :

Code:

Set wk2 = Workbooks("Comparaison2.xls")

pourtant à la place de Comparaison2.xls je lui indique l'emplacement exacte sur le disque du classeur 2 à comparer
11/01/2007, 12h18
Pierre Fauconnier
Ce n'est pas l'emplacement que tu dois donner, mais le nom du fichier, sans son chemin d'accès... du moins si ce fichier est ouvert. S'il ne l'est pas, la syntaxe devient
Code:

1 2 set wk2 = workbooks.open("MonFichierAvecSonCheminComplet")

donc en gros je résume le script total et tu me dis si je me trompe

ton script de départ me permet de selectionner les classeur à comparer en les selectionnant dans leur entier :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub comparaisontableur()
Dim wk1 As Workbook ' Classeur 1
    Dim wk2 As Workbook ' Classeur 2
    Dim wk3 As Workbook ' Classeur de résultat
 
    Dim Plage1 As Range ' Plage du classeur1
    Dim Plage2 As Range ' Plage du classeur 2
 
    Dim Ligne As Long, Colonne As Integer ' Positionnement de la cellule dans la plage
 
    Set wk1 = Workbooks("Codes TAC - Octobre 06.xls")
    Set wk2 = Workbooks("Codes TAC - 05 Dec 06.xls")
    Set wk3 = Workbooks("C:\Documents and Settings\ghipeau\Bureau\PROJET 2\code tac\resultatcomparaison.xls")
 
    Set Plage1 = wk1.Worksheets("feuil1").Range("a1:a10")
    Set Plage2 = wk2.Worksheets("feuil1").Range("a1:a10")
 
    For Ligne = 1 To Plage1.Rows.Count ' on itère sur les lignes DE LA PLAGE
        For Colonne = 1 To Plage1.Columns.Count ' et sur les colonnes DE LA PLAGE
            If Plage1.Cells(Ligne, Colonne) <> Plage2.Cells(Ligne, Colonne) Then
                MsgBox "Différence sur la cellule " & Plage1.Cells(Ligne, Colonne).Address ' Affichage si <>
            End If
        Next Colonne
    Next Ligne
 
    Set Plage1 = Nothing
    Set Plage2 = Nothing
    Set plage3 = Nothing
End Sub

ensuite tu as ton script suivant qui recherche les elements modifié :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub RechercheElements(PlageBase As Range, PlageRecherche As Range)
    Dim Cellule As Range
    Dim CelResultat As Range
 
    For Each Cellule In PlageBase
        Set CelResultat = PlageRecherche.Find(what:=Cellule.Value, LookIn:=xlValues, lookat:=xlWhole)
        If CelResultat Is Nothing Then MsgBox Cellule.Value & " non trouvé"
    Next Cellule
End Sub
 
Sub Comparaison()
    Dim rngMoisPrecedent As Range
    Dim rngMoisEnCours As Range
 
    Set rngMoisPrecedent = Feuil1.Range("a2:a10")
    Set rngMoisEnCours = Feuil2.Range("a2:a10")
 
    RechercheElements rngMoisPrecedent, rngMoisEnCours ' recherche des suppressions
    RechercheElements rngMoisEnCours, rngMoisPrecedent ' recherche des ajout => inversion des plages
End Sub

et pour finir si je veut avoir les éléments ajoutés et suprimé faut que j'adapte le dernier script que tu m'as donné

j'ai tout bon ou j'ai tout faut
donc les deux script ce suivent

11/01/2007, 12h48
M@XflY

bon merci maintenant ça fonctionne il m'ouvre bien un classeur résultat avec trois feuilles (d'ailleurs faut que je modifie le code pour qu'il me créer une classeur résultat, car là je suis obligé de le créer à la main)

mais par contre il me génere une erreur ici :

Code:

Set Plage1 = wk1.Worksheets("feuil1").Range("a1:a10")
11/01/2007, 13h03
ouskel'n'or

Quel est le message ? Ça pourrait nous éclairer ;)
A+
11/01/2007, 13h08
Pierre Fauconnier

Citation:

j'ai tout bon ou j'ai tout faut
donc les deux script ce suivent

Ben, dison que tu as un peu faux... et un peu juste.

Les différents scripts t'ont été donnés au fur et à mesure de l'évolution de la discussion.

De mon premier code, tu dois supprimer toute la partie qui traite de la comparaison, et utiliser mes derniers codes pour comparer les cellules et renvoyer les résultats dans ta feuille récapitulative.

Et comme le dit Ouskel'n'or, donne le message d'erreur, c'est tellement plus simple pour essayer de voir ce qui se passe...
11/01/2007, 13h11
M@XflY

toujours la meme :

Erreur d'execution 9

l'indice n'appartient pas à la sélection
11/01/2007, 13h19
M@XflY

Citation:

Envoyé par Pierre Fauconnier

Ben, dison que tu as un peu faux... et un peu juste.

Les différents scripts t'ont été donnés au fur et à mesure de l'évolution de la discussion.

De mon premier code, tu dois supprimer toute la partie qui traite de la comparaison, et utiliser mes derniers codes pour comparer les cellules et renvoyer les résultats dans ta feuille récapitulative.

Et comme le dit Ouskel'n'or, donne le message d'erreur, c'est tellement plus simple pour essayer de voir ce qui se passe...

ok merki

donc ignoré la dernière erreur que je viens de poster au post#18

je refait le script avec ce que tu viens de me dire et si il y a une erreur je t'indique le message d'erreur et la ligne correspondante

PS : désolé je suis un peu newbie dans tout ça

Citation:

Envoyé par Pierre Fauconnier

De mon premier code, tu dois supprimer toute la partie qui traite de la comparaison, et utiliser mes derniers codes pour comparer les cellules et renvoyer les résultats dans ta feuille récapitulative.

voilà j'essaye ce que tu m'as dit mais je vois pas trop dans ton code de départ ce qui traite de la comparaison

j'ai essayé ça en remplacant comme tu m'as dit :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 Sub Comparaison() Dim wk1 As Workbook ' Classeur 1 Dim wk2 As Workbook ' Classeur 2 Dim wk3 As Workbook ' Classeur de résultat Set wk1 = Workbooks("Codes TAC - Octobre 06.xls") Set wk2 = Workbooks.Open("C:\Documents and Settings\ghipeau\Bureau\PROJET 2\code tac\Codes TAC - 05 Dec 06.xls") Set wk2 = Workbooks.Open("C:\Documents and Settings\ghipeau\Bureau\PROJET 2\code tac\resultatcomparaison.xls") Dim rngMoisPrecedent As Range Dim rngMoisEnCours As Range Set rngMoisPrecedent = Feuil1.Range("a2:a10") Set rngMoisEnCours = Feuil2.Range("a2:a10") RechercheElements rngMoisPrecedent, rngMoisEnCours ' recherche des suppressions RechercheElements rngMoisEnCours, rngMoisPrecedent ' recherche des ajout => inversion des plages End Sub Sub RechercheElements(PlageBase As Range, PlageRecherche As Range) Dim Cellule As Range Dim CelResultat As Range For Each Cellule In PlageBase Set CelResultat = PlageRecherche.Find(what:=Cellule.Value, LookIn:=xlValues, lookat:=xlWhole) If CelResultat Is Nothing Then MsgBox Cellule.Value & " non trouvé" Next Cellule End Sub
mais comme ça me génere une erreur :
Erreur d'execution 424 : objet requis

et ça me surligne ça :

Code:

Set rngMoisEnCours = Feuil2.Range("a2:a10")

je suis sur que ce que j'ai fait et faux mais comme je suis débutant en VB j'ai dus mal à voir ce que je dois virer dans ton premier script

PS : je continu à chercher en bidouillant le code et en essayant de le comprendre ligne par ligne

bon je repart de zero :

de ton premier script je pense qu'il faut que je conserve ça :

Code:

1
2
3
4
5
6
7
8
9
 
Sub Comparaison()
    Dim wk1 As Workbook ' Classeur 1
    Dim wk2 As Workbook ' Classeur 2
    Dim wk3 As Workbook ' Classeur de résultat
 
    Set wk1 = Workbooks("Codes TAC - Octobre 06.xls")
    Set wk2 = Workbooks.Open("C:\Documents and Settings\ghipeau\Bureau\PROJET 2\code tac\Codes TAC - 05 Dec 06.xls")
    Set wk2 = Workbooks.Open("C:\Documents and Settings\ghipeau\Bureau\PROJET 2\code tac\resultatcomparaison.xls")

ça indique l'endroit où se trouve les classeurs à traité

bon je continu

bon apres épuration de ce que j'ai compris j'obtient ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Sub Comparaison()
    Dim wk1 As Workbook ' Classeur 1
    Dim wk2 As Workbook ' Classeur 2
    Dim wk3 As Workbook ' Classeur de résultat
 
    Set wk1 = Workbooks("Codes TAC - Octobre 06.xls")
    Set wk2 = Workbooks.Open("C:\Documents and Settings\ghipeau\Bureau\PROJET 2\code tac\Codes TAC - 05 Dec 06.xls")
    Set wk2 = Workbooks.Open("C:\Documents and Settings\ghipeau\Bureau\PROJET 2\code tac\resultatcomparaison.xls")
 
    Dim rngMoisPrecedent As Range
    Dim rngMoisEnCours As Range
 
    Set rngMoisPrecedent = Feuil1.Range("a2:a10")
    Set rngMoisEnCours = Feuil2.Range("a2:a10")
 
    RechercheElements rngMoisPrecedent, rngMoisEnCours ' recherche des suppressions
    RechercheElements rngMoisEnCours, rngMoisPrecedent ' recherche des ajout => inversion des plages
 
End Sub
Sub RechercheElements(PlageBase As Range, PlageRecherche As Range)
    Dim Cellule As Range
    Dim CelResultat As Range
 
    For Each Cellule In PlageBase
        Set CelResultat = PlageRecherche.Find(what:=Cellule.Value, LookIn:=xlValues, lookat:=xlWhole)
        If CelResultat Is Nothing Then MsgBox Cellule.Value & " non trouvé"
    Next Cellule
End Sub

mais j'ai toujours la meme erreur qu'au post #20

PS : j'ai lus l'aide qu'il y a avec le debugger mais j'ai pas plus oompris

11/01/2007, 16h54
M@XflY

là franchement je bloque completement je retourne le probleme dans tout les sens et j'ai toujours cette erreur

le probleme c'est comme je comprend pas l'erreur j'avance pas
11/01/2007, 17h30
M@XflY

bon on reprend tout depuis le début :

je vais poser l'algorithme de la macro :

Macro Excel :
Algo :

selection du premier classeur à comparer
ouverture du second classeur à comparer
creation du classeur resultat
creation de trois feuilles ajout, suppression, modification dans le classeur resultat

Parcours du premier tableau ligne par ligne
Parcours du second tableau ligne par ligne

si valeur premier tableau différent valeur second tableau alors
_ si valeur premier tableau = null et valeur second tableau =vraie
alors stocké valeurs dans feuille ajout du classeur resultat
_ si valeur premier tableau=vraie et valeur second tableau=null aors stocké valeurs dans feuille suprimé du classeur resultat
_ si valeur premier tableau=valeur second tableau+1
alors stocké valeurs dans feuille modifié

sinon parcourir le tableau
finsi
fin algo
13/01/2007, 10h07
SfJ5Rpw8
sans aller plus loin dans ces lignes :
Code:

1 2 3 Set rngMoisPrecedent = Feuil1.Range("a2:a10") Set rngMoisEnCours = Feuil2.Range("a2:a10"
tu défini des plages appartenant tout les 2 à des feuilles du classeur Actif.... feuilles dont le "CodeName" (Nom visible dans l'éditeur VBE, dans l'arborescence du projet...) est Feuil1 et Feuil2 ... je pense que ce n'est pas ces feuilles que tu veu comparer !

utilse tes wk1 et wk2... par exemple :
Code:

1 2 3 Set rngMoisPrecedent = wk1.Sheets("LeNomDeLaFeuille").Range("a2:a10") Set rngMoisEnCours = wk2.Sheets("LeNomDeLaFeuille").Range("a2:a10"
13/01/2007, 13h24
M@XflY

ok merci pour le tuyau je test ça dès que 5 mn