Macro recherche spécifique
Bonjour à tous,
je viens vers vous pour un petit problème. Je souhaiterai une macro pour faire pas mal de choses pour mon travail.
Je vous joins un fichier pour que cela soit plus explicite.
Dans la colonne A (pouvant contenir 500000 lignes voire plus) j'importe des éléments d'un autre fichier. Je supprime les blancs et les doublons. Dans la colonne B, j'importe des informations (texte ou chiffre, cette colonne peut contenir jusqu'à 300000 lignes). Jusque là j'y arrive!
Je souhaiterais comparer les éléments de la colonne A (mais pas à l'identique ex si dans A j'ai 1234567 et que dans B j'ai 123456789 je voudrais qu'il le trouve sans excéder 3 caractères non identiques ). Je souhaiterai effacer toutes les cellules contenant du texte dans la colonne B et avoir les résultats de la comparaison dans la colonne D.
Enfin, dans la colonne C, des éléments seront liés à la colonne B et je voudrais que lorsque la comparaison matche, les éléments de la colonne C soit en colonne E....
J'ai essayé quelques trucs mais ce n'est pas probant en plus le délai d’exécution est très long...
Je vous remercie tous de votre attention et de vos réponses!
Ps: si par bonheur vous pouviez concrétiser ce projet, laisser les commentaires des commandes que je puisse refaire d'autres macro par la suite grâce à vos conseils!
bonjour,
dans ton exemple, je comprends la logique de toutes les lignes, sauf celle de la ligne 20, je ne comprends pas pourquoi elle est sélectionnée et je ne comprends pas le point commun mis en colonne D.
La ligne 20 matche car il y a la cellule A17
Merci de ton attention prêter à mon problème
La ligne 20 à matché car il y a la cellule A17. Merci de l'attention que tu portes à mon projet!
Bonjour,
voir si ceci te convient (je n'ai pas exactement le même résultat que toi
Sub aarg()
pl = Cells(1, 1).End(xlDown).Row
dl = Cells(Rows.Count, 1).End(xlUp).Row
For i = pl To dl
For j = pl To dl
a = Cells(i, 1)
b = Cells(j, 2)
If Abs(Len(a) - Len(b)) < 3 Then
lr = IIf(Len(a) > Len(b), Len(b), Len(a))
If Left(a, lr) = Left(b, lr) Then
If Len(Cells(i, 4)) < lr Then
Cells(i, 4) = Left(a, lr)
Cells(i, 5) = Cells(j, 3)
End If
End If
End If
Next j
Next i
End Sub
Bonjour,
Cela ne fonctionne pas...cela marche que pour une ligne et ça ne renvoie pas
Le résultat de la colonne d'a côté. En colonne C est associé la colonne b.
Merci de votre aide.
c'est que je n'ai pas compris la logique que tu voulais appliquer.
par exemple pourquoi 1234 est-il associé à jeans et pas à 36 ?
si tu pouvais expliquer pour chaque ligne pourquoi on obtient le résultat qu tu indiques.
Voilà je t'envoie un fichier test qui récapitule tout mon projet. Je crois que cela va être difficile...
J'ai décidé de m'y mettre sérieusement car c'est un univers qui parait passionnant!
Merci encore de cette attention portée.
bonjour,
je ne parviens toujours pas à obtenir le même résultat que celui que tu indiques dans ta feuille (je n'ai pas compris la logique)
je te donne cependant une version de ce que j'ai compris de ta demande. la liste contient les mêmes éléments mais pas dans le même ordre.
Sub aargh()
dla = Cells(Rows.Count, 1).End(xlUp).Row
dlc = Cells(Rows.Count, 3).End(xlUp).Row
r = 2
For j = 3 To dlc
aco = Cells(j, 3) 'on recherche la base
For i = 3 To dla
ach = Cells(i, 1) ' dans éléments à comparer
If Abs(Len(ach) - Len(aco)) < 4 Then 'on garde les différence de longueurs <4
lac = IIf(Len(aco) < Len(ach), Len(aco), Len(ach)) ' on détermine la longueur pour la comparaison (longueur du plus petit élément)
If Left(aco, lac) = Left(ach, lac) Then 'on a trouvé un élément qui correspond
r = r + 1 ' on incrémente le numéro de ligne du résultat
Cells(r, 7) = Cells(j, 3) ' on copie la base
Cells(r, 8) = Cells(j, 4) ' on copie la base associée
Cells(r, 9) = Cells(j, 5) 'on copie la couleur
Exit For
End If
End If
Next i
Next j
End Sub
Bonjour,
une autre version
Sub aargh()
dla = Cells(Rows.Count, 1).End(xlUp).Row
dlc = Cells(Rows.Count, 3).End(xlUp).Row
r = 2
For i = 3 To dla
ach = Cells(i, 1) 'on recherche la base
For j = 3 To dlc
aco = Cells(j, 3) ' dans éléments à comparer
If comsstr(ach, aco, 3) Then
r = r + 1
Cells(r, 7) = Cells(j, 3) ' on copie la base
Cells(r, 8) = Cells(j, 4) ' on copie la base associée
Cells(r, 9) = Cells(j, 5) 'on copie la couleur
Exit For
End If
Next j
Next i
End Sub
Function comsstr(a, b, Optional dif = 3) As Boolean
If Abs(Len(a) - Len(b)) > dif Then comsstr = False: Exit Function
If Len(a) < Len(b) Then
ltc = Len(a)
sa = a
sb = b
Else
ltc = Len(b)
sa = b
sb = a
End If
For j = 1 To Len(sb)
For i = ltc To Len(sb) - dif Step -1
sc = Mid(sa, j, i)
If Abs(Len(sc) - Len(sb)) <= dif Then
If InStr(sb, sc) <> 0 Then comsstr = True: Exit Function
End If
Next i
Next j
comstr = False
End Function
Bonjour,
j'ai essayé la deuxième version de ton code et la partie comparaison des deux colonnes fonctionne très bien sur le fichier exemple. Cependant, j'ai copié la macro sur le fichier d'origine et il ne fonctionne pas: il me renvoie une valeur située dans une cellule en ligne X alors que cette valeur n'est pas demandée. Mais je referais toutes mes macros sur le fichier exemple pour ne pas t'embêter trop...
J'apporte une précision j'espère être plus clair:
la colonne BASE est issue d'un fichier csv sur la colonne E de la feuille 2 (dans l'exemple).
la colonne BASE ASSOCIEE est issue d'un code que je demande mais en fait elle n'a pas forcément besoin d'etre en FEUILLE 1.
En effet, une fois la comparaison faite entre ELEMENTS A COMPARER et BASE, il faudrait rechercher la valeur qui a été trouvée et mise dans la colonne RESULTATS dans le fichier BASE (feuille 2) et récupérer la valeur en colonne B sur la meme ligne (ex: si valeur trouvée apres comparaison est 777777, il faudrait récupérer 5).
Ensuite , il faudrait rechercher ce 5 (par exemple) dans le fichier BASE ASSOCIEE Feuille 3 (cette fois ci en respectant la chaine car je peux avoir 115 par exemple) et copier la ligne où il y a ce 5 dans la colonne RESULTATS de la feuille 1 (dans l'exemple SWEATS JAUNES mais il y a d'autres colonne en plus a droite normalement).
Le résultat est en fait issu de base croisées que je ne peux malheureusement pas rassembler car le 5 dans la feuille 2 peux avoir plusieurs lignes dans la feuille 3.
Je suis désolé de te déranger autant mais ce code est vraiment important pour moi car cela aiderait énormément à l'exploitation de données récupérées dans mon travail.
Merci encore pour votre aide et votre attention.
Désolé encore du dérangement.
Cordialement.
Bonjour.
En fait ton code ne fonctionne pas. Avec les valeurs de l'exemple oui. Sinon il me renvoie une valeur en C8460 qui n'est même pas dans éléments à comparer.
Je suis dégouté...
Merci encore.
bonsoir,
comme signalé par MP je ne parviens pas à reproduire le problème que tu signales.
voici une version qui tient compte de ta nouvelles demandes liées à la création de la base associée( basée sur (feuil2 et feuil3)
Sub aargh()
With Sheets("feuil1")
dla = .Cells(Rows.Count, 1).End(xlUp).Row
dlc = .Cells(Rows.Count, 3).End(xlUp).Row
r = 2
'étape 1
'creation de la base associée
For i = 3 To dlc
Set re = Sheets("feuil2").Columns("E:E").Find(Cells(i, 3), LookIn:=xlValues, lookat:=xlWhole) 'recherche du numéro en feuil2
If Not re Is Nothing Then
Set re = Sheets("feuil3").Columns("A:A").Find(re.Offset(0, -3), LookIn:=xlValues, lookat:=xlWhole) 'recherche du numero de feuil2 dans feuil3
If Not re Is Nothing Then
.Cells(i, 4) = re.Offset(0, 1)
.Cells(i, 5) = re.Offset(0, 2)
End If
End If
Next i
'étape 2 recherche des éléments à comparer
For i = 3 To dla
ach = .Cells(i, 1) 'on recherche les éléments à comparer
For j = 3 To dlc
aco = .Cells(j, 3) ' dans la base
If comsstr(ach, aco, 3) Then
r = r + 1
.Cells(r, 7) = .Cells(j, 3) ' on copie la base
.Cells(r, 8) = .Cells(j, 4) ' on copie la base associée
.Cells(r, 9) = .Cells(j, 5) 'on copie la couleur
Exit For
End If
Next j
Next i
End With
End Sub
Function comsstr(a, b, Optional dif = 3) As Boolean
If Abs(Len(a) - Len(b)) > dif Then comsstr = False: Exit Function
If Len(a) < Len(b) Then
ltc = Len(a)
sa = a
sb = b
Else
ltc = Len(b)
sa = b
sb = a
End If
For j = 1 To Len(sb)
For i = ltc To Len(sb) - dif Step -1
sc = Mid(sa, j, i)
If Abs(Len(sc) - Len(sb)) <= dif Then
If InStr(sb, sc) <> 0 Then comsstr = True: Exit Function
End If
Next i
Next j
comsstr = False
End Function
Merci H2SO4!!
Ça a l'air de fonctionner! Par contre il me renvoie la première
Valeur à trois caractère qu'il trouve en base même si ce n'est pas dans éléments à comparer.
J'ai plus qu'à l'adapter et c'est nickel!
Merci du temps accorder!
Bonjour à tous!
H2so4, j'ai modifié ton code de façon à avoir l'étape 1 en étape 2 car sinon ça me crée la base associée sur toute la colonne C
Et avec 100000 entrées c'était beaucoup trop long. La ça me crée la base associée que sur les résultats de la comparaison.
Cependant, il me prend toujours la première valeur à trois caractères qu'il trouve en colonne C même s'il n'est pas en colonne A.
Je ne comprends pas pourquoi et je bloque.
Si quelqu'un pouvait jeter un petit coup d'œil ce serait sympa.!
Merci à tous !
Cordialement !
Innuendo67 a écrit :Bonjour à tous!
(...)
Cependant, il me prend toujours la première valeur à trois caractères qu'il trouve en colonne C même s'il n'est pas en colonne A.
Je ne comprends pas pourquoi et je bloque.
Si quelqu'un pouvait jeter un petit coup d'œil ce serait sympa.!
Merci à tous !
Cordialement !
peux-tu mettre un exemple ?
Bonjour H2SO4 et désolé de ne pas avoir répondu avant.
Je te mets un fichier avec ton code modifié (mal). Il s'appelle arghhv2. En faisant du pas à pas détaillé, tu pourras enfin comprendre ma logique. J'ai mis volontairement un numéro à 3 chiffres (454) dans la base pour que tu vois qu'il me le trouve même s'il n'est pas en colonne A (éléments à comparer). Il arrive aussi bien souvent qu'il ne trouve pas des valeurs à moins de 3 caractères d'écart. Peut-être mes données contiennent elles des caractères cachés vu que ce sont des imports de .csv?
De plus, sur mon fichier origine le code est très long à s’exécuter. As-tu des solutions pour l’accélérer?
Je te remercie de ton attention.
Cordialement.
Bonjour,
une nouvelle version
Peux-tu me mettre des exemples ?Il arrive aussi bien souvent qu'il ne trouve pas des valeurs à moins de 3 caractères d'écart.
Bonjour H2SO4.
Je te joints un exemple de non comparaison avec moins de trois caractères d'écart.
Si cela fonctionne chez toi c'est bizarre car j'ai essayé ce fichier sur plusieurs ordinateurs et version d'excel différentes et cela ne fonctionne jamais.
De plus, aurais-tu une solution quant à la lenteur de la macro? Sur peu de données c'est efficace mais dès que j'attaque les 100000 lignes ça coince...
Je te remercie encore de ton attention portée à mon problème.
Cordialement.
bonjour,
une nouvelle correction, sache qu'il y a une limite de 15 caractères à la longueur des nombres.