Extraction de valeurs différentes
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:
1
2
3
4
5
6
7
8
9
10
11
12
|
Code:
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:
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.
Extraction de valeurs différentes
Citation:
Envoyé par
bbil
qu'appelle tu extraire ? car je ne comprends pas ce code :
Code:
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 "
Extraction de valeurs différentes
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.
Recherche de valeurs uniques grâce aux collections Excel VBA
Hello carla13,
Citation:
Envoyé par
bbil
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)
Citation:
Envoyé par
carla13
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:
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 :
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 :
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:
For Each RgValeur In Sheets("feuil1").Range("a500:a10500")
coûte (pour 10000 valeurs) 1 seconde de plus que :
Code:
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 :
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 :resolu:
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 http://www.developpez.net/forums/ima.../vote1left.gif ci-dessous.
