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

ADOL

XLDnaute Nouveau
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.
 

Pièces jointes

  • Fichier Exempl.xlsm
    36.3 KB · Affichages: 11
Solution
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 =...

Dranreb

XLDnaute Barbatruc
Ma fonction s'utilise en validation normale, non matricielle.
Mais le plus souvent elle ne fait que consulter un Dictionary constitué une seule fois à la première évaluation effectuée depuis plus d'une seconde.
Je suis en train d'étudier une version avec utilisation plutôt d'une Collection, et avec une gestion d'erreur …
 

ADOL

XLDnaute Nouveau
Ma fonction s'utilise en validation normale, non matricielle.
Mais le plus souvent elle ne fait que consulter un Dictionary constitué une seule fois à la première évaluation effectuée depuis plus d'une seconde.
Je suis en train d'étudier une version avec utilisation plutôt d'une Collection, et avec une gestion d'erreur …
Re
J'ai testé ta fonction sur le fichier principal et aussi sur un autre fichier important, mais sur les 2 fichiers j'obtiens l'erreur suivante (Erreur de compilation / Type défini par l'utilisateur non défini) et le module s'ouvre pour souligner ( Dic As Dictionary).
J'ai tous vérifié mais le code est bien copié sans aucune faute !!
 

Dranreb

XLDnaute Barbatruc
Cochez la référence Microsoft Scripting Runtime.
Je n'utilise jamais les Dictionary en liaisons tardives, je trouve ça complètement idiot.

La version avec une Collection VBA qui ne nécessite plus cette référence.
 

Pièces jointes

  • DicoADOL.xlsm
    42.5 KB · Affichages: 2

ADOL

XLDnaute Nouveau
Cochez la référence Microsoft Scripting Runtime.
Je n'utilise jamais les Dictionary en liaisons tardives, je trouve ça complètement idiot.

La version avec une Collection VBA qui ne nécessite plus cette référence.
J'ai collé attentivement le code sur le fichier principal, mais dans les cases j'obtiens toujours (#VALEUR!)
j'ai vérifié toutes les références mais aucune faute ni erreur.
 

Dranreb

XLDnaute Barbatruc
Joignez ce que vous appelez le fichier principal
Avez vous vu qu'il y avait aussi du code dans Feuil2 (Feuil2) ? :
VB:
Option Explicit
Private ClnConsigne As New Collection
Public Sub AjoutConsigne(ByVal Quoi As Range)
   ClnConsigne.Add Quoi
   End Sub
Private Sub Worksheet_Calculate()
   Dim Rng As Range
   If ClnConsigne.Count = 0 Then Exit Sub
   Set Rng = ClnConsigne(1)
   ClnConsigne.Remove 1
   Application.Goto Rng
   MsgBox "Correction " & Rng.Address(False, False), vbInformation
   End Sub
 

Discussions similaires

Statistiques des forums

Discussions
313 288
Messages
2 096 838
Membres
106 758
dernier inscrit
JM9