Excel vba comparer 2 listes

30/07 à 22:20Bonjour,

La procédure suivante fait la job mais elle possède le défaut de ne pas conserver le classement de la deuxième série de colonnes.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 2008-07-24 par St-Gelais Jacques
'

'
Range("H1").Formula = "=COUNTA(C[-7]:C[-7])"
Range("I1").Formula = "=COUNTA(C[-6]:C[-6])"
Range("K1").Formula = "=COUNTA(C[-7]:C[-7])"
Range("L1").Formula = "=COUNTA(C[-6]:C[-6])"
Range("J1").Formula = "=MAX(RC[-1],RC[2])"

valeurA = Range("H1").Value 'NBVAL(A:A)
valeurD = Range("K1").Value 'NBVAL(D:D)
valeur = valeurA + valeurD 'soit le maximum possiblement
A = "A"
C = "C"
D = "D"
F = "F"
AA = "AA"
AC = "AC"
AD = "AD"
AF = "AF"
If UCase(Left(Range("A1").Value, 4)) = "DATE" Then
entête = 2
Range(AA & "1:" & AF & "1").Value = Range(A & "1:" & F & "1").Value
Else
entête = 1
End If
ligne = entête
ligneA = ligne
ligneD = ligne
PetiteLigne = ligne
compteur = ligne
'Je fais une copie de sécurité avant tout
Columns("BA:BF").Value = Columns("A:F").Value

'Je classe les 3 première et les 3 autres.
Columns("A:C").Select
Selection.Sort Key1:=Range("A" & entête), Order1:=xlAscending, Key2:=Range("C" & entête) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Columns("D:F").Select
Selection.Sort Key1:=Range("D" & entête), Order1:=xlAscending, Key2:=Range("F" & entête) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
While compteur <= valeur
DateA = Range(A & ligne).Value
NomC = Range(C & ligne).Value
DateD = Range(D & ligne).Value
NomF = Range(F & ligne).Value

If DateD <> "" And DateA = "" Then
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If

If DateD = "" And DateA <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If
'Si la date dans D est inférieur à A, je transfère tout simplement D à F et
'j'écrase D à F par la suite des données
While DateD < DateA And DateD <> ""
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
DateD = Range(D & ligne).Value
compteur = compteur + 1
Wend

'Prochaine étape = les dates identiques
DateA = Range(A & ligne).Value
NomC = Range(C & ligne).Value
DateD = Range(D & ligne).Value
NomF = Range(F & ligne).Value
If DateD = DateA And NomF = NomC And NomF <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
End If
If DateD = DateA And NomF <> NomC And NomF <> "" Then
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If
'Si la date dans D est supérieur à A, je transfère tout simplement A à C et
'j'écrase A à C par la suite des données
If DateD > DateA And DateA <> "" And DateD <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
DateD = Range(D & ligne).Value
End If
compteur = compteur + 1
Wend
Range("A1").Select
End Sub

----------
Singe laid

30/07 à 22:25Bonjour,

Voici une procédure VBA qui fera ton affaire mais elle a le défaut de ne pas conserver le trie des 3 dernières colonnes.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 2008-07-24 par St-Gelais Jacques
'

'
Range("H1").Formula = "=COUNTA(C[-7]:C[-7])"
Range("I1").Formula = "=COUNTA(C[-6]:C[-6])"
Range("K1").Formula = "=COUNTA(C[-7]:C[-7])"
Range("L1").Formula = "=COUNTA(C[-6]:C[-6])"
Range("J1").Formula = "=MAX(RC[-1],RC[2])"

valeurA = Range("H1").Value 'NBVAL(A:A)
valeurD = Range("K1").Value 'NBVAL(D:D)
valeur = valeurA + valeurD 'soit le maximum possiblement
A = "A"
C = "C"
D = "D"
F = "F"
AA = "AA"
AC = "AC"
AD = "AD"
AF = "AF"
If UCase(Left(Range("A1").Value, 4)) = "DATE" Then
entête = 2
Range(AA & "1:" & AF & "1").Value = Range(A & "1:" & F & "1").Value
Else
entête = 1
End If
ligne = entête
ligneA = ligne
ligneD = ligne
PetiteLigne = ligne
compteur = ligne
'Je fais une copie de sécurité avant tout
Columns("BA:BF").Value = Columns("A:F").Value

'Je classe les 3 première et les 3 autres.
Columns("A:C").Select
Selection.Sort Key1:=Range("A" & entête), Order1:=xlAscending, Key2:=Range("C" & entête) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Columns("D:F").Select
Selection.Sort Key1:=Range("D" & entête), Order1:=xlAscending, Key2:=Range("F" & entête) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
While compteur <= valeur
DateA = Range(A & ligne).Value
NomC = Range(C & ligne).Value
DateD = Range(D & ligne).Value
NomF = Range(F & ligne).Value

If DateD <> "" And DateA = "" Then
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If

If DateD = "" And DateA <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If
'Si la date dans D est inférieur à A, je transfère tout simplement D à F et
'j'écrase D à F par la suite des données
While DateD < DateA And DateD <> ""
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
DateD = Range(D & ligne).Value
compteur = compteur + 1
Wend

'Prochaine étape = les dates identiques
DateA = Range(A & ligne).Value
NomC = Range(C & ligne).Value
DateD = Range(D & ligne).Value
NomF = Range(F & ligne).Value
If DateD = DateA And NomF = NomC And NomF <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
End If
If DateD = DateA And NomF <> NomC And NomF <> "" Then
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If
'Si la date dans D est supérieur à A, je transfère tout simplement A à C et
'j'écrase A à C par la suite des données
If DateD > DateA And DateA <> "" And DateD <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
DateD = Range(D & ligne).Value
End If
compteur = compteur + 1
Wend
Range("A1").Select
End Sub

----------
Singe laid

31/07 à 11:41Bonjour,
je mets ce lien ici parce qu'il y a des pistes intéressantes http://www.excelabo.net/excel/comparerplages.php

----------
le bonheur n'est pas au bout du chemin, il EST le chemin
http://i22.servimg.com/u/f22/11/12/87/18/22-1810.jpg

01/08 à 17:09Bonjour,

Voici la procédure VBA qu'il faudra placer tout simplement dans un module.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 2008-07-24 par St-Gelais Jacques
'

'
Range("H1").Formula = "=COUNTA(C[-7]:C[-7])"
Range("I1").Formula = "=COUNTA(C[-6]:C[-6])"
Range("K1").Formula = "=COUNTA(C[-7]:C[-7])"
Range("L1").Formula = "=COUNTA(C[-6]:C[-6])"
Range("J1").Formula = "=MAX(RC[-1],RC[2])"

valeurA = Range("H1").Value 'NBVAL(A:A)
valeurD = Range("K1").Value 'NBVAL(D:D)
valeur = valeurA + valeurD 'soit le maximum possiblement
A = "A"
C = "C"
D = "D"
F = "F"
AA = "AA"
AC = "AC"
AD = "AD"
AF = "AF"
If UCase(Left(Range("A1").Value, 4)) = "DATE" Then
entête = 2
Range(AA & "1:" & AF & "1").Value = Range(A & "1:" & F & "1").Value
Else
entête = 1
End If
ligne = entête
ligneA = ligne
ligneD = ligne
PetiteLigne = ligne
compteur = ligne
'Je fais une copie de sécurité avant tout
Columns("BA:BF").Value = Columns("A:F").Value

'Je classe les 3 première et les 3 autres.
Columns("A:C").Select
Selection.Sort Key1:=Range("A" & entête), Order1:=xlAscending, Key2:=Range("C" & entête) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Columns("D:F").Select
Selection.Sort Key1:=Range("D" & entête), Order1:=xlAscending, Key2:=Range("F" & entête) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
While compteur <= valeur
DateA = Range(A & ligne).Value
NomC = Range(C & ligne).Value
DateD = Range(D & ligne).Value
NomF = Range(F & ligne).Value

If DateD <> "" And DateA = "" Then
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If

If DateD = "" And DateA <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If
'Si la date dans D est inférieur à A, je transfère tout simplement D à F et
'j'écrase D à F par la suite des données
While DateD < DateA And DateD <> ""
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
DateD = Range(D & ligne).Value
compteur = compteur + 1
Wend

'Prochaine étape = les dates identiques
DateA = Range(A & ligne).Value
NomC = Range(C & ligne).Value
DateD = Range(D & ligne).Value
NomF = Range(F & ligne).Value
If DateD = DateA And NomF = NomC And NomF <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
End If
If DateD = DateA And NomF <> NomC And NomF <> "" Then
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If
'Si la date dans D est supérieur à A, je transfère tout simplement A à C et
'j'écrase A à C par la suite des données
If DateD > DateA And DateA <> "" And DateD <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
DateD = Range(D & ligne).Value
End If
compteur = compteur + 1
Wend
Range("A1").Select
End Sub

----------
Singe laid

09/08 à 16:12Bonjour,
j'ai voulu tester ta macro...hem...ça m'a tout effacé !!!!

----------
le bonheur n'est pas au bout du chemin, il EST le chemin
http://i22.servimg.com/u/f22/11/12/87/18/22-1810.jpg

09/08 à 18:51tit question en passant , combien peut t'il y avaoir de valeur(de ligne) au maximum dans un colonne ?????

----------

un long moment de détente http://spiralbol.free.fr
Partagez vos humeurs http://humeur.forum-actif.net/

10/08 à 16:19Bonjour,

Je refais ma réponse car le système a sauté.

La procédure copie les colonnes selon la demande dans les colonnes AA à AF tout en effaçant les colonnes A à F. J'aurais dû ajouter une commande de déplacement à AA1.

Les colonnes originales A à F sont recopiés dans BA à BF

----------
Singe laid

10/08 à 16:24Bonjour,

Pour le nombre de valeur, la procédure compare les 3 colonnes avec les 3 autres colonnes pour 2 données avec entête ou sans entête ce qui donne 65536 lignes ou 65535 lignes de données.

En passant, comme j'écris du Québec, il faut voir 6 heures entre l'heure où j'écris par rapport à l'heure affichée au message.

Ma réponse de 16:19 a été écrite ici à 10:19. Ma journée commence alors que la votre est sur le bord de finir.

----------
Singe laid

10/08 à 21:01bon alors j'ai presque cerné le truc sans macro( sport cérébral )

le tout c'est de savoir combien de ligne il peut y avoir au maximum

j'ai travaillé pour 200 lignes mais ça donne un classeur monstreux

pas grave ce qui compte c'est le principe et le principe fonctionne

alors COMBIEN DE LIGNE ????????

----------

un long moment de détente http://spiralbol.free.fr
Partagez vos humeurs http://humeur.forum-actif.net/

10/08 à 23:45Bonjour,
ben...tu vas rire... j'en sais rien ! c'est pas prévisible à l'avance

----------
le bonheur n'est pas au bout du chemin, il EST le chemin
http://i22.servimg.com/u/f22/11/12/87/18/22-1810.jpg

11/08 à 00:48ta bien une estimation du max , y'a que ça qui m'interesse

pour l'instant je peut traité 100 ligne c assez ou pas

ça donne un monstre de feuille de calcul, mais pas grave c pour la beautée du geste, faire ça sans MACRO

----------

un long moment de détente http://spiralbol.free.fr
Partagez vos humeurs http://humeur.forum-actif.net/

11/08 à 16:21Bonjour,

Avec la macro, le maximum de ligne est sans importance.

Quel est ta solution exactement s.v.p.

----------
Singe laid

11/08 à 16:32une solution MONSTREUSE, mais c'est pas grave c pour le fun, j'adore ce genre de manipulation

evidement les MACRO sont plus rapide et moins lourde, mais je voulais voir si on pouvais obtenir le même résultat avec des formules bien torteuse, et ben OUI. j'ai obtenue la liste voulu, reste a en faire qu'une avec tout parce que je ai deux

une avec les données de la liste de droite (double et orpheline)et une avec la liste des données de gauche orpheline.

il faut encore que j'intègre les données orphelines de gauche dans la liste compléte de droite.

je réfléchi je réfléchi

je vais tanter de t'expliquer ma façon de faire dans un prochain post

tu verra c'est pas piqué des hannetons

Modifie par spiralbol le 11/08/2008 à  16:

----------

un long moment de détente http://spiralbol.free.fr
Partagez vos humeurs http://humeur.forum-actif.net/

11/08 à 16:58Le procédé j'ai essayé de faire une explication simple .

Chaque ligne contient 3 données : une date, un nom, un prix et ce dans deux tableau

1er) je concatène les 3 données de chaque tableau en les séparant d'un caractère identifiable, ce qui me donne une seule donnée par ligne de tableau, je me retrouve donc avec deux séries de donnée, tableau de droite et tableau de gauche

2em) ensuite j'extrais la valeur numérique des tout les caractères des donnés une à une et par tableau

3em) j'additionne toute ces valeurs ce qui me donne une valeur numérique correspondant a la donnée de chaque ligne pour chaque tableau

4em) je compare toute les valeurs numérique du tableau de droite au tableau de gauche, les valeurs qui sont identique correspondent a des données d'origine identique dans les deux tableaux, ceux qui ne trouve pas de correspondance sont des lignes orphelines

5em) il ne reste plus cas faire l'inverse, c'est-à-dire reconstitué les deux tableaux en recomposant chaque valeur: date, nom; prix pour chaque ligne en laissant vierge sur le tableau de gauche ou de droite les lignes qui non pas trouvé de correspondance.

Modifie par spiralbol le 11/08/2008 à  16:

----------

un long moment de détente http://spiralbol.free.fr
Partagez vos humeurs http://humeur.forum-actif.net/

11/08 à 17:15Bonjour,
commence avec 100 lignes, on verra après

----------
le bonheur n'est pas au bout du chemin, il EST le chemin
http://i22.servimg.com/u/f22/11/12/87/18/22-1810.jpg

11/08 à 18:51Bonjour,


Voici la procédure modifiée afin de faire apparaître le résultat voulu dans la colonne A à F commme il devrait être et effacer le contenu de AA à AF.

J'ai simplement ajouter 2 lignes à la fin.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 2008-07-24 par St-Gelais Jacques
'

'
Range("H1").Formula = "=COUNTA(C[-7]:C[-7])"
Range("I1").Formula = "=COUNTA(C[-6]:C[-6])"
Range("K1").Formula = "=COUNTA(C[-7]:C[-7])"
Range("L1").Formula = "=COUNTA(C[-6]:C[-6])"
Range("J1").Formula = "=MAX(RC[-1],RC[2])"

valeurA = Range("H1").Value 'NBVAL(A:A)
valeurD = Range("K1").Value 'NBVAL(D:D)
valeur = valeurA + valeurD 'soit le maximum possiblement
A = "A"
C = "C"
D = "D"
F = "F"
AA = "AA"
AC = "AC"
AD = "AD"
AF = "AF"
If UCase(Left(Range("A1").Value, 4)) = "DATE" Then
entête = 2
Range(AA & "1:" & AF & "1").Value = Range(A & "1:" & F & "1").Value
Else
entête = 1
End If
ligne = entête
ligneA = ligne
ligneD = ligne
PetiteLigne = ligne
compteur = ligne
'Je fais une copie de sécurité avant tout
Columns("BA:BF").Value = Columns("A:F").Value

'Je classe les 3 première et les 3 autres.
Columns("A:C").Select
Selection.Sort Key1:=Range("A" & entête), Order1:=xlAscending, Key2:=Range("C" & entête) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Columns("D:F").Select
Selection.Sort Key1:=Range("D" & entête), Order1:=xlAscending, Key2:=Range("F" & entête) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
While compteur <= valeur
DateA = Range(A & ligne).Value
NomC = Range(C & ligne).Value
DateD = Range(D & ligne).Value
NomF = Range(F & ligne).Value

If DateD <> "" And DateA = "" Then
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If

If DateD = "" And DateA <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If
'Si la date dans D est inférieur à A, je transfère tout simplement D à F et
'j'écrase D à F par la suite des données
While DateD < DateA And DateD <> ""
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
DateD = Range(D & ligne).Value
compteur = compteur + 1
Wend

'Prochaine étape = les dates identiques
DateA = Range(A & ligne).Value
NomC = Range(C & ligne).Value
DateD = Range(D & ligne).Value
NomF = Range(F & ligne).Value
If DateD = DateA And NomF = NomC And NomF <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
End If
If DateD = DateA And NomF <> NomC And NomF <> "" Then
Range(AD & PetiteLigne & ":" & AF & PetiteLigne).Value = Range(D & ligne & ":" & F & ligne).Value
Range(D & ligne & ":" & F & valeur).Value = Range(D & ligne + 1 & ":" & F & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
End If
'Si la date dans D est supérieur à A, je transfère tout simplement A à C et
'j'écrase A à C par la suite des données
If DateD > DateA And DateA <> "" And DateD <> "" Then
Range(AA & PetiteLigne & ":" & AC & PetiteLigne).Value = Range(A & ligne & ":" & C & ligne).Value
Range(A & ligne & ":" & C & valeur).Value = Range(A & ligne + 1 & ":" & C & valeur + 1).Value
PetiteLigne = PetiteLigne + 1
DateD = Range(D & ligne).Value
End If
compteur = compteur + 1
Wend
Columns("A:F").Value = Columns("AA:AF").Value
Columns("AA:AF").ClearContents
Range("A1").Select
End Sub

----------
Singe laid

11/08 à 22:54bon j'ai terminé

ça donne un classeur de monstreux
41 MO en version 97
4 MO en version 2007

mais ça marche , je suis content dans être venue a bout, a part quelques erreurs minime dans les dates du deuxieme tableau tout fonctionne.

maintenant que j'ai mis au point le principe je pourrais trés bien l'optimisé pour le rendre moins lourd et plus rapide, parce que je suis sur qu'il y a un tas de cellule remplis de fonction qui ne servent a rien.


mais bon , ce que je voulais c'est arriver a le faire sans MACRO, donc je suis content. J'aime ce genre de chalange

j'essais de t'envoyé la purée GASTON, je te previent comme je l'ai dit au début c'est une ebauche non optimisé, comme tu verra il suffit de modifier les données des double tableau de droite, pour que le double tableau de gauche fasse le trie.

j'espere que l'email va passer 41 MO ça ne devrais pas coinçé

Modifie par spiralbol le 11/08/2008 à  22:

----------

un long moment de détente http://spiralbol.free.fr
Partagez vos humeurs http://humeur.forum-actif.net/

12/08 à 05:24Bonjour,

Tu as combien de lignes de données avec ton fichier de 41 MO?

Peux-tu me l'envoyer? Même chose pour le fichier de Gaston juste pour voir le temps d'exécution.

Je ne vaux rien en fonction Excel; je suis plus fort en VBA.

Bye vous à deux.

----------
Singe laid

12/08 à 10:34(quote]Je ne vaux rien en fonction Excel; je suis plus fort en VBA[/quote]

ben moi c'est le contraire

mon fichier heuuuuuuuuuuu y'a 5 onglets chaque feuille de calcul contient environ 100 ligne ( pour 100 donnée ) et en nombre de colonne ça va de 6 a 100 e fonction de ce que j'y fait

j'ai pas put envoyé le fichier a GASTON ça boite mail( l'adresse que j'ia ne repond pas)

pour toi Geo tu peut avoir mon adresse ici

>http://spiralbol.free.fr/contact.htm<

envois moi un ti mot je te renverrais la purée par retour du courrier
je te prévient ce n'est qu'une ebauche absolument pas optimisé, donc TRES LOURDE et TRES LENTE, c'était juste pour étudier le principe, une fois celui ci établie , je doit pouvoir faire mieux mais la c'est une autre histoire, je suis en vaccance quand même

Modifie par spiralbol le 12/08/2008 à  10:

----------

un long moment de détente http://spiralbol.free.fr
Partagez vos humeurs http://humeur.forum-actif.net/

12/08 à 13:17Bonjour,

Gaston et toi envoyez-moi vos fichiers à

geogeojacke@yahou.ca

C'est une adresse que je ne me sert plus mais elle serait encore valide.

Bye

----------
Singe laid