Discussion :

[carla13]

Bonjour,

je souhaiterais extraire à l'aide d'une macro les valeurs différentes de deux colonnes.

J'utilise la macro ci-après qui fonctionne bien mais qui met un temps interminable pour calculer.

Existe-t-il une formule beaucoup plus rapide.

Voici ce que je recherche pour exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

	

	
Code  :
	
Sélectionner tout -
	Visualiser dans une fenêtre à part
	
123456789
 
colonne A                           Colonne B              COLONNE C
 1800                                  4511                    5231
 1500                                  1800                    2310
 2310                                  3000 
 4511                                  25689                   
 5231                                  1500  
 
 etc jusqu'à 10000

Je souhaite que mes valeurs : colonne A : 2310 et 5231 soient extraites En COLONNE C car différentes de colonne B

voici ma macro "escargot"...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub epureFOREACHB1()
 
Dim valeur, resultat As Variant
 
Application.ScreenUpdating = False
For Each valeur In S
heets("feuil3").Range("a:a1000")
For Each resultat In Sheets("feuil3").Range("b:b1500")
On Error Resume Next
If valeur.Value <> resultat.Value Then
resultat.Value = resultat.Value
Else: valeur.Value = 0
End If
Next
Next
Application.ScreenUpdating = True
 
End Sub

Par avance merci.

[jfontaine]

Bonjour,

Une autre solution qui évitera une boucle dans la colonne B

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub epureFOREACHB1()
 
Dim RgValeur As Range
Dim Rg As Range
Dim i As Long
 
Application.ScreenUpdating = False
i = 1
 
For Each RgValeur In Sheets("feuil1").Range("a1:a10000")
    Set Rg = Range("B:B").Find(RgValeur.Value)
    If Rg Is Nothing Then
        Range("C" & i).Value = RgValeur.Value
        i = i + 1
    End If
Next
 
Application.ScreenUpdating = True
 
End Sub

[SfJ5Rpw8]

qu'appelle tu extraire ? car je ne comprends pas ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
If valeur.Value <> resultat.Value Then
resultat.Value = resultat.Value
Else: valeur.Value = 0
End If

si la condition est respecté tu ne fais rien .... : resultat.Value = resultat.Valueet si elle est respecté tu n'extrait rien mais tu met la valeur en colonne A à 0 : valeur.Value = 0

[carla13]

qu'appelle tu extraire ? car je ne comprends pas ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
If valeur.Value <> resultat.Value Then
resultat.Value = resultat.Value
Else: valeur.Value = 0
End If

si la condition est respecté tu ne fais rien .... : resultat.Value = resultat.Valueet si elle est respecté tu n'extrait rien mais tu met la valeur en colonne A à 0 : valeur.Value = 0

Effectivement, ici dans ce cas rien n'est extrait. (si la condition "=" est remplie = 0 (qui reste sur place colonne A) ; si valeur différente = valeur conservée dans cette même colonne.

ce que je souhaiterais c'est que la valeur différente apparaissent dans une autre colonne ; que l'opération s'effectue beaucoup plus rapidement qu' avec "for each "

[SfJ5Rpw8]

Effectivement, ici dans ce cas rien n'est extrait. (si la condition "=" est remplie = 0 (qui reste sur place colonne A) ; si valeur différente = valeur conservée dans cette même colonne.

ce que je souhaiterais c'est que la valeur différente apparaissent dans une autre colonne ; que l'opération s'effectue beaucoup plus rapidement qu' avec "for each "

pour conserver une valeur ce n'est pas la peine de re-écrire cette valeur il suffit de ne pas y toucher ...


tu as vu le code à jfontaine ...?

[carla13]

Oui je viens d'essayer le code de JFontaine et le résultat est probant.

Il n'y a qu'un détail qui me gêne
1°) c'est que les valeurs différentes extraites en colonne C (beaucoup plus rapidement merci !) comporte des doublons. comment éviter un filtre supplémentaire.
(Je n'avais pas précisé il est vrai ce cas)

2°) comment procéder si mes colonnes ne sont pas en A1 : B1 resultat C1
mais A500 : B500 RESULTAT EN C 500 (car ici "C" m'écrase d'autres données situées en C1 : C500)

Merci.

[jfontaine]

Tu fais 2 recherches (une sur B et l'autre sur C)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub epureFOREACHB1()
 
Dim RgValeur As Range
Dim Rg As Range
Dim i As Long
 
Application.ScreenUpdating = False
 
 
For Each RgValeur In Sheets("feuil1").Range("a1:a10000")
    Set Rg = Range("B:B").Find(RgValeur.Value)
    If Rg Is Nothing Then
        i= rg.Row 
        Set Rg = Range("C:C").Find(RgValeur.Value)
        If Rg Is Nothing Then
            Range("C" & i).Value = RgValeur.Value
        End if
    End If
Next
 
Application.ScreenUpdating = True
 
End Sub

EDIT : Ajout du traitement de la ligne colonne C

[SfJ5Rpw8]

pour le 1°) j'ai bien une idée en utilisant une collection comme tampon pour éviter les doublons ( tu stoke les données trouvées dans une collection cMaCol.add... et tu pose le résultat en fin de parcours de la colonne A ...)


pour le 2) je ne comprends pas ... tes histoire 1, 500... le code de jpfontaine pose les résultats dans la colonne c en rajoutant 1 au numéro de ligne à chaque nouvelle égalité ... cela ne te vas pas ..?

[carla13]

Le premier code fonctionne à merveille. Cependant j'avais pris comme exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
 
   colonne A       Colonne B          Colonne C (Résultat)
 A1 -> A1000 -    B1 -> B1000 -         C1 --> XXX

N° 2

Maintenant imaginons que je démarre en A500-B500 mes données à comparer.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
   colonne A              Colonne B                     Colonne C (Résultat)
 
 A500 -> A1000      - B 500 -> B 1000          C 500 -> C xxxx

Ce que je souhaite c'est retrouver mes résultats à partir de "C500" car après avoir testé je retrouve mon résultat en C 1 et il m'écrase d'autres données placées à cet endroit ?

En espérant avoir été plus clair.

Par avance merci.

[MattChess]

Hello carla13,

j'ai bien une idée en utilisant une collection comme tampon pour éviter les doublons

Excellente suggestion, bbil ! C'est beaucoup plus rapide que le Range.Find(value)

comment procéder si mes colonnes ne sont pas en A1 : B1 resultat C1
mais A500 : B500 RESULTAT EN C 500

Il faut décrire la feuille avec des constantes comme dans le code ci-joint.
Comme cela on a à modifier que les constantes et pas les procédures si les emplacements des données ou des résultats changent !

1. Comparez la solution de la collection avec la solution du Range.Find()

Ouvrir Excel. Une feuille vide apparaît.
Ouvrir le Visual Basic Editeur par Alt+F11, c-a-d :
Excel menu "Outils" > "Macro" > "Visual Basic Editeur" (VBE)

Cliquez sur le VBE menu "Insérer" > "Module".
Dans la fenêtre d'Edition de Module1, copier-coller :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Option Explicit
Public Const rowStart = 500
Public Const rowEnd = 10500
 
Public Const colSourceA = 1
Public Const colSourceB = colSourceA + 1
Public Const colResult = colSourceB + 1
 
Sub MesurePerf()
Dim tStart As Double, tEnd As Double
 
    ClearResult
    tStart = Time
    epureFOREACHB1_Matt
    tEnd = Time
    Debug.Print "Matt: " + Format(tEnd - tStart, "HH:MM:SS")
 
    ClearResult ' Mettre le point d'arrêt dans la marge de cette ligne
    tStart = Time
    epureFOREACHB1_JP
    tEnd = Time
    Debug.Print "JP: " + Format(tEnd - tStart, "HH:MM:SS")
End Sub
 
Sub epureFOREACHB1_Matt()
Dim indRowSource As Integer, indRowTarget As Integer, value As Integer
Dim collResult As Collection, collB As Collection, strKey As String
    Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    Set collB = New Collection: Set collResult = New Collection
    For indRowSource = rowStart To rowEnd
        strKey = CStr(Cells(indRowSource, colSourceB))
        If Not IsInCollection(collB, strKey) Then
            collB.Add vbNull, key:=strKey ' The value is not used in the collection only the key
        End If
    Next
    indRowTarget = rowStart
    For indRowSource = rowStart To rowEnd
        value = Cells(indRowSource, colSourceA)
        strKey = CStr(value)
        If Not IsInCollection(collB, strKey) Then
            If Not IsInCollection(collResult, strKey) Then
                collResult.Add vbNull, key:=strKey
                Cells(indRowTarget, colResult) = value
                indRowTarget = indRowTarget + 1
            End If
        End If
    Next
    Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
    Set collResult = Nothing: Set collB = Nothing
End Sub
 
Function IsInCollection(ByVal collList As Collection, ByVal strKey As String) As Boolean
Dim value As Integer
 
    On Error Resume Next
    value = collList(strKey)
    IsInCollection = Err.Number = 0
    On Error GoTo 0
End Function
 
Sub epureFOREACHB1_JP()
Dim RgValeur As Range
Dim Rg As Range
Dim i As Long
Application.ScreenUpdating = False
i = rowStart ' was 1
For Each RgValeur In Sheets("feuil1").Range("a500:a10500") 'was Range("a1:a10000")
    Set Rg = Range("B:B").Find(RgValeur.value)
    If Rg Is Nothing Then
'        i = Rg.Row
        Set Rg = Range("C:C").Find(RgValeur.value)
        If Rg Is Nothing Then
            Range("C" & i).value = RgValeur.value
            i = i + 1
        End If
    End If
Next
Application.ScreenUpdating = True
End Sub
 
Sub ClearResult()
    Range(Cells(rowStart, colResult), Cells(rowEnd, colResult)).ClearContents
End Sub
 
Sub RandomValue()
Dim indRow As Integer
 
    For indRow = rowStart To rowEnd
        Cells(indRow, colSourceA) = CInt(Rnd() * rowEnd)
        Cells(indRow, colSourceB) = CInt(Rnd() * rowEnd)
    Next
End Sub

Sauvegardez la maquette dans FindColl.xls

2. Usage

La feuille Excel étant vide, on va générer 10000 nombres aléatoires dans les deux premières colonnes à partir de A500 et B500.

Dans la fenêtre d'Exécution immédiate (Ctlr+G) du VBE, copier-coller et valider par ENTER :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

RandomValue

Vérifier qu'il y a bien des nombres sur deux colonnes entre A500 et A10500. Idem en colonne B.

Dans la fenêtre d'Edition de Module1 mettre un point d'arrêt sur le deuxième ClearResult ligne 18 en cliquant dans la marge jusqu'à avoir un point rouge. Toute la ligne devient rouge.

Dans la fenêtre d'Exécution immédiate, copier-coller et valider par ENTER :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MesurePerf

Matt: 00:00:01

MesurePerf() s'arrête sur le point d'arrêt et la ligne ClearResult devient jaune.
Basculer du VBE vers la fenêtre de la feuille de calcul.
Vérifier que la colonne C a été remplie par des nombres uniques de la colonne A n'appartenant pas à la colonne B.

Sélectionner toute la colonne C en cliquant sur "C" dans l'entête des colonnes.
Cliquez avec le bouton droit de la souris, menu contextuel "Insérer" colonne.
Cela permet de conserver la colonne de résultats établis par epureFOREACHB1_Matt() en colonne D, la colonne C nouvellement insérée étant vide.

Retourner dans la fenêtre du VBE.
VBE menu "Run" > "Continue" (F5) c-a-d continuer l'exécution de MesurePerf()

JP: 00:00:34
Le temps peut dépendre de la puissance du PC et des données. Il mesure le temps d'exécution de epureFOREACHB1_JP() dont les Range ont été adaptés pour traiter les nombres à partir de A500 et B500 avec résultat dans C500.

3. For Each Next vs. For Next

Notez que :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each RgValeur In Sheets("feuil1").Range("a500:a10500")

coûte (pour 10000 valeurs) 1 seconde de plus que :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
For indRowSource = rowStart To rowEnd
        value = Cells(indRowSource, colSourceA)

C'est le coût de la Programmation Orientée Objet (POO) dont les avantages de conception restent indéniables.

4. Mesure de performance

Malgré l'initialisation de la collection collB avec les valeurs uniques de la colonne B, le mécanisme de clé unique dans la collection est beaucoup plus performant que le Range.Find(value).

Dans la fenêtre d'Edition du Module1, enlevez le point d'arrêt en cliquant sur le point rouge dans la marge en face de ClearResult.
Relancez la mesure de performance dans la fenêtre d'Exécution immédiate :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MesurePerf

Matt: 00:00:01
JP: 00:00:34

Vérifier que les deux algorithmes donnent le même résultat en comparant la colonne C générée par epureFOREACHB1_JP() et la colonne D générée par epureFOREACHB1_Matt() après insertion d'une nouvelle colonne C vide au chapitre 2.
___________

Si la discussion est résolue, vous pouvez cliquer sur le bouton

En bas de ce message s'il vous a apporté des éléments de réponse pertinents, pensez également à voter en cliquant sur le bouton vert ci-dessous.

[carla13]

Impressionnant !!!!

Merci à vous tous, vous m'avez apporté une aide précieuse.