XL 2010 Renvoyer le N° de ligne d'une partie numérique identique à un code

ADOL · 16 Juin 2023

Bonjour/Bonsoir à Vous toutes et tous.
J'ai beaucoup essayé et beaucoup recherché mais en vain, et me voilà je me dirige vers vous pour m'aider à trouver mon besoin.
J'ai un fichier excel qui compte actuellement plus de 8600 lignes, sur lequel j'utilise une formule matricielle quavec laquelle le fichier
est devenu très très lent, lourd, fatigant et ennuyeux

De ce fait, je viens vers demander votre m’aide d'avoir une "Macro" qui compare, au moment de la saisie sur la feuil.1, une partie numérique
d’un code saisi, avec des codes existant dans l’autre feuille (Feuil.2) et renvoie automatiquement sur la même feuil.2 dans la case correspondant
de la colonne D, Le N° de la ligne du code similaire saisi sur la feuil.1.

Avec le fichier exempl, il y’a une Macro qui fait la même fonction souhaitée, mais il doit être adapté par les connaisseurs pour correspondre
le fichier exempl selon sa mise en forme actuelle, qui est identique au fichier principal.

Tous les détails nécessaires sont fournis avec le fichier ci-joint et j'espère avoir été bien claire ds mes détails

Je vous remercie beaucoup, par avance, pour le temps que vous avez voulu prendre pour mon aide.

ADOL · 17 Juin 2023

vgendron à dit:

Comme on ne sait pas s'il y a 2 ou 3 ou plus d'espace... j'ai ajouté un code pour supprimer tous les espaces

VB:

Sub ChercheCode3()

Dim Tab1() As Variant 'déclaration tablo vba
Dim Tab2() As Variant
Offset = 6 'pour compenser le démarrage du tableau à la ligne 7

With Sheets("Feuil1") 'avec la feuille1
    LastLine = .Range("C" & .Rows.Count).End(xlUp).Row 'dernière ligne NON vide de la colonne C
    Tab1 = .Range("G7:G" & LastLine).Value 'on met la colonne G dans le tablo
End With

With Sheets("Feuil2") 'avec la feuille2
    LastLine = .Range("E" & .Rows.Count).End(xlUp).Row 'dernière ligne NON vide de la colonne E
    Tab2 = .Range("D9:E" & LastLine).Value 'on met les colonne D et E dans le tablo
End With

Set dico1 =...

vgendron · 16 Juin 2023

Hello
pas sur d'avoir compris le besoin, ni sur quelles feuilles travailler
mais voici un test

VB:

Sub ChercheCode2()

Dim Tab1() As Variant
Dim Tab2() As Variant
Offset = 6 'pour compenser le démarrage du tableau à la ligne 7

With Sheets("Feuil1")
    LastLine = .Range("C" & .Rows.Count).End(xlUp).Row
    Tab1 = .Range("G7:G" & LastLine).Value
End With

With Sheets("Feuil2")
    LastLine = .Range("E" & .Rows.Count).End(xlUp).Row
    Tab2 = .Range("D9:E" & LastLine).Value
End With

Set dico1 = CreateObject("Scripting.Dictionary")

For i = LBound(Tab1, 1) To UBound(Tab1, 1)
    clé = Split(Tab1(i, 1), " ")(1)
    If Not dico1.exists(clé) Then
        dico1.Add clé, i
    End If
Next i

For i = LBound(Tab2, 1) To UBound(Tab2, 1)
    Tab2(i, 1) = dico1(CStr(Tab2(i, 2))) + Offset
Next i

Sheets("Feuil2").Range("D9:E" & LastLine).Value = Tab2
End Sub

Oneida · 16 Juin 2023

Bonjour a tous et toutes,
A priori, c'est une recherche de la partie numerique d'un mouvement colonne G de la feuil1 dans la feuil2 colonne E.
Si existe, alors ecrire le numero de ligne de la cellule feuil1 colonne G qui vient d'etre saisie dans la cellule colonne D feuil2 a la meme ligne que la cellule trouvee colonne F
Pas besoins de Dico
ADOL:
Donc il n'y aura jamais de code du genre 51368 en feuil2 provenant du mouvement CV 51368A feuil1?

Dranreb · 16 Juin 2023

Bonjour.
Une proposition avec une fonction perso utilisant un Dictionary

ADOL · 16 Juin 2023

vgendron à dit:

Hello
pas sur d'avoir compris le besoin, ni sur quelles feuilles travailler
mais voici un test

VB:

Sub ChercheCode2()

Dim Tab1() As Variant
Dim Tab2() As Variant
Offset = 6 'pour compenser le démarrage du tableau à la ligne 7

With Sheets("Feuil1")
    LastLine = .Range("C" & .Rows.Count).End(xlUp).Row
    Tab1 = .Range("G7:G" & LastLine).Value
End With

With Sheets("Feuil2")
    LastLine = .Range("E" & .Rows.Count).End(xlUp).Row
    Tab2 = .Range("D9:E" & LastLine).Value
End With

Set dico1 = CreateObject("Scripting.Dictionary")

For i = LBound(Tab1, 1) To UBound(Tab1, 1)
    clé = Split(Tab1(i, 1), " ")(1)
    If Not dico1.exists(clé) Then
        dico1.Add clé, i
    End If
Next i

For i = LBound(Tab2, 1) To UBound(Tab2, 1)
    Tab2(i, 1) = dico1(CStr(Tab2(i, 2))) + Offset
Next i

Sheets("Feuil2").Range("D9:E" & LastLine).Value = Tab2
End Sub

Bonsoir vgendron
Merci d'abord de m'avoir réservé un temps pour m'aider.
j'ai essayé le code et il me renvoie "erreur.9 > l'indice n'appartient pas à la sélection.

La saisie quotidienne se faite sur la feuil.1
les codes sont toujours préchargé à la feuil.2
Pour plus de précision les codes ne pourrons jamais être en doublons
un code est toujours unique
Est-ce claire ?

vgendron · 16 Juin 2023

Vu que ca fonctionne très bien avec le fichier fourni.. qu'as tu modifié dans ton fichier final?

Erreur 9 = souvent pb de syntaxe dans le nom de la feuille... par exemple

ADOL · 16 Juin 2023

Oneida à dit:
Bonjour a tous et toutes,
A priori, c'est une recherche de la partie numerique d'un mouvement colonne G de la feuil1 dans la feuil2 colonne E.
Si existe, alors ecrire le numero de ligne de la cellule feuil1 colonne G qui vient d'etre saisie dans la cellule colonne D feuil2 a la meme ligne que la cellule trouvee colonne F
Pas besoins de Dico
ADOL:
Donc il n'y aura jamais de code du genre 51368 en feuil2 provenant du mouvement CV 51368A feuil1?

Merci d'abord pour l’intérêt et le temps que vous avez apportés à mon sujet.
En réponse à ta question, c'est non, il n'y aura jamais un code de 5 chiffre ou de 8 chiffre ou un code doublon

Oneida · 16 Juin 2023

ADOL à dit:
Merci d'abord pour l’intérêt et le temps que vous avez apportés à mon sujet.
En réponse à ta question, c'est non, il n'y aura jamais un code de 5 chiffre ou de 8 chiffre ou un code doublon

Vous avez teste le fichier que j'ai mis a dipos?

ADOL · 16 Juin 2023

vgendron à dit:
Vu que ca fonctionne très bien avec le fichier fourni.. qu'as tu modifié dans ton fichier final?

Erreur 9 = souvent pb de syntaxe dans le nom de la feuille... par exemple

je suis encore sur le fichier exemple et j'ai rien modifié.
J'ai juste copié et collé le code pour essai et l'erreur s'est affiché.

je v vérifié ... peut être une chose accidentelle

vgendron · 16 Juin 2023

Oneida à dit:
Vous avez teste le fichier que j'ai mis a dipos?

bug sur le ubound(a)

Edit1
Hello !
edit2: le bug est sur la macro initiale du fichier
ta solution fonctionne très bien également

ADOL · 16 Juin 2023

Dranreb à dit:
Bonjour.
Une proposition avec une fonction perso utilisant un Dictionary

Merci beaucoup d'avoir pris le temps dans mon aide.
j'utilisais auparavant une fonction (=trouvecode(xx;valeurs;codes)), mais cette solution de formule dans des milliers de cellules à fait le fichier très lent

ADOL · 16 Juin 2023

vgendron à dit:
bug sur le ubound(a)

Edit1
Hello !
edit2: le bug est sur la macro initiale du fichier
ta solution fonctionne très bien également

Oui ça fonctionne très bien maintenant, c'était une erreur lié apparemment aux autres feuils
Mais je vois sur la feuil.2, que le (N°6) se répète 3 fois sur 3 code différents !!!
Voir fichier ci-joint
Pourquoi??

ADOL · 16 Juin 2023

Oneida à dit:
Vous avez teste le fichier que j'ai mis a dipos?

J'ai rien trouvé à tester dans le fichier.
je vois juste une feuil.3 vide !!!

vgendron · 16 Juin 2023

ADOL à dit:
Oui ça fonctionne très bien maintenant, c'était une erreur lié apparemment aux autres feuils
Mais je vois sur la feuil.2, que le (N°6) se répète 3 fois sur 3 code différents !!!
Voir fichier ci-joint
Pourquoi??

Exact: erreur lorsque le code n'existe pas dans la feuille 1

voici le code commenté et corrigé

VB:

Sub ChercheCode2()

Dim Tab1() As Variant 'déclaration tablo vba
Dim Tab2() As Variant
Offset = 6 'pour compenser le démarrage du tableau à la ligne 7

With Sheets("Feuil1") 'avec la feuille1
    LastLine = .Range("C" & .Rows.Count).End(xlUp).Row 'dernière ligne NON vide de la colonne C
    Tab1 = .Range("G7:G" & LastLine).Value 'on met la colonne G dans le tablo
End With

With Sheets("Feuil2") 'avec la feuille2
    LastLine = .Range("E" & .Rows.Count).End(xlUp).Row 'dernière ligne NON vide de la colonne E
    Tab2 = .Range("D9:E" & LastLine).Value 'on met les colonne D et E dans le tablo
End With

Set dico1 = CreateObject("Scripting.Dictionary") 'création d'un dictionaire

For i = LBound(Tab1, 1) To UBound(Tab1, 1) 'pour chaque ligne du tablo
    clé = Split(Tab1(i, 1), " ")(1) 'on récupère la partie numérique pour en faire la clé
    If Not dico1.exists(clé) Then 'si la clé n'existe pas
        dico1.Add clé, i 'on ajoute la clé avec son indice
    End If
Next i

For i = LBound(Tab2, 1) To UBound(Tab2, 1) 'pour chaque ligne
    If dico1.exists(CStr(Tab2(i, 2))) Then 'si la clé existe
        Tab2(i, 1) = dico1(CStr(Tab2(i, 2))) + Offset 'on met sa valeur (indice) + offset
    End If
Next i

Sheets("Feuil2").Range("D9:E" & LastLine).Value = Tab2 'on copie le résultat dans la feuille
End Sub

Dranreb · 16 Juin 2023

ADOL à dit:
j'utilisais auparavant une fonction (=trouvecode(xx;valeurs;codes)), mais cette solution de formule dans des milliers de cellules à fait le fichier très lent

De par sa conception, ma fonction ne devrait pas avoir cet inconvénient.

XL 2010 Renvoyer le N° de ligne d'une partie numérique identique à un code

ADOL

XLDnaute Nouveau

Pièces jointes

ADOL

vgendron

XLDnaute Barbatruc

Oneida

XLDnaute Impliqué

Pièces jointes

Dranreb

XLDnaute Barbatruc

Pièces jointes

ADOL

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

ADOL

XLDnaute Nouveau

Oneida

XLDnaute Impliqué

ADOL

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

ADOL

XLDnaute Nouveau

ADOL

XLDnaute Nouveau

Pièces jointes

ADOL

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Discussions similaires

XL 2010 Renvoyer le N° de ligne d'une partie numérique identique à un code

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

​

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Impliqué

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires