Discussion :

[Mist-e-Fire]

Bonjour,

Je suis en train d'essayer de mettre au point une macro contenant une formule Vlookup sur des morceaux de tailles différentes au sein d'une cellule.

J'ai une feuille de donnée dans lequel l'utilisateur va entrer des ID de 6 ou 7 caractère (Ex: 9578/1, 2359/14, 5423/S,...) dans la colonne 10 (J). Ces entrées peuvent être multiples sur une seule cellule Ex (2489/2;2356/12;1108/S; ) ou pas. J'ai demandé à ces utilisateurs de toujours terminer un ID par un ";" même en cas d'entrée unique (il n'y aura que quelques utilisateurs qui seront entrainés au remplissage du formulaire).
Ces ID renvoient à une seconde feuille du classeur dans laquelle, associé à chaque ID, il y a des cellules de description.
Je voudrais renvoyer automatiquement ces 3 cellules de descriptions à coté de la cellule ou l'utilisateur écrit l'ID (chaque descriptif sera séparé d'un "; " dans la cellule).

Je n'arrive pas à réaliser une formule avec le problème du nombre de caractère aléatoire, donc j'ai tenté la macro... Mais ça ne marche pas non plus

Voici le code:

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim actuPosition As Integer
Dim equipIdLen As Integer
Dim valueLookup As String
Dim equipType As String
Dim equipDescr As String
Dim equipModel As String
 
 
If Target.Column = 10 And Target <> "" Then
    actuPosition = 1
    equiptType = ""
    equipDescr = ""
    equipModel = ""
    Do Until actuPosition > Len(Target) - 5 ' will loop lookup as long as there is another equipment ID to look for
        equipIdLen = Application.Search(";", Target, actuPosition) - actuPosition - 1 'length of searched equipment ID without ; symbol
        valueLookup = Mid(Target, actuPosition, equipIdLen) 'Extract equipID value
        equipType = equipType & Application.VLookup(valueLookup, Sheets("Equipment").Range("A:U"), 5, 0) & "; "
        equipDescr = equipDescr & Application.VLookup(valueLookup, Sheets("Equipment").Range("A:U"), 6, 0) & "; "
        equipModel = equipModel & Application.VLookup(valueLookup, Sheets("Equipment").Range("A:U"), 7, 0) & "; "
        actuPosition = actuPosition + equipIdLen 'Move position in cell to the next equipID beginning
    Loop
    Target.Offset(0, 1) = equipType
    Target.Offset(0, 2) = equipDescr
    Target.Offset(0, 3) = equipModel
End If
 
End Sub

Actuellement, le programme bloque sur la ligne du premier Vlookup en me disant "Type Mismatch"
Est-ce que vous voyez un moyen de corriger/compléter ma macro?

Merci
Olivier

[Mist-e-Fire]

J'ai réussi à faire fonctionner la macro!

Voici le nouveau code:

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim actuPosition As Integer
Dim equipIdLen As Integer
Dim valueLookup As String
Dim equipType As String
Dim equipDescr As String
Dim equipModel As String
 
 
If Target.Column = 10 And Target <> "" Then
    actuPosition = 1
    equiptType = ""
    equipDescr = ""
    equipModel = ""
    Do Until actuPosition > Len(Target) - 5 ' will loop lookup as long as there is another equipment ID to look for
        equipIdLen = Application.Search(";", Target, actuPosition) - actuPosition 'length of searched equipment ID without ; symbol
        valueLookup = Mid(Target, actuPosition, equipIdLen) 'Extract equipID value
        equipType = equipType & Application.VLookup(valueLookup, Sheets("Equipment").Range("A:U"), 5, 0) & "; "
        equipDescr = equipDescr & Application.VLookup(valueLookup, Sheets("Equipment").Range("A:U"), 6, 0) & "; "
        equipModel = equipModel & Application.VLookup(valueLookup, Sheets("Equipment").Range("A:U"), 7, 0) & "; "
        actuPosition = actuPosition + equipIdLen + 1 'Move position in cell to the next equipID beginning
    Loop
    Target.Offset(0, 1) = equipType
    Target.Offset(0, 2) = equipDescr
    Target.Offset(0, 3) = equipModel
End If
 
End Sub

Il me reste une question:
Quand j'écris un ID qui n'existe pas dans ma table d'ID, je reçois un "Type Mismatch" error et il ouvre VBA pour afficher la ligne.
comment faire pour que l'utilisateur ait simplement un "N/A" à la place?

Merci

[Mist-e-Fire]

Bon, en désespoir, j'ai utilisé "On error resume next".
C'est pas la meilleur solution, mais ça fait l'affaire.

Du coup, c'est (auto)résolu!