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
|
Function Recherche_Concatener(Référence_Cherchée As String, TableMatrice As range, Indice_Colonne_Référence_Cherchée As Integer, Index_Colonne_Description As Integer, Taille_Colonne As Integer) As String
'********************************************************************************************************************************
'Cette fonction concatène dans une seule cellule toutes les descriptions en recherchant leur identifiant dans un autre onglet
'Les identifiants ou "Référence_Cherchée" doivent être espacés d'un retour à la ligne
'********************************************************************************************************************************
Application.Volatile True 'Permet à la fonction de se recalculer immédiatement
Dim Tableau
Dim i, j As Integer
Dim FinLigne As Integer
FinLigne = TableMatrice.End(xlDown).Row 'Retourne la dernière ligne non vide du tableau de recherche
Recherche_Concatener = ""
Tableau = Split(Référence_Cherchée, Chr(10)) 'Permet de mettre dans le tableau les caractères de la chaîne d'identifiants espacés du caractère spécial "Retour à la ligne <=> Ch(10)
For i = 0 To UBound(Tableau) '1° Boucle sur chaque identifiant d'exigence
Référence_Cherchée = Tableau(i)
If Référence_Cherchée = "" Then
Exit For
Else
'Ici, on balaye ligne par ligne (j) le tableau défini en argument et on concatène toutes les préconisations
For j = 0 To FinLigne
If TableMatrice(j, Indice_Colonne_Référence_Cherchée) = Référence_Cherchée Then
Recherche_Concatener = Recherche_Concatener & TableMatrice(j, Index_Colonne_Description) & Chr(10) & String(Taille_Colonne, "_") & Chr(10)
j = FinLigne - 1
End If
Next j
End If
Next i
'Suppression du dernier retour à la ligne et des caractères spéciaux
If Recherche_Concatener = "" Then
Recherche_Concatener = ""
Else
Recherche_Concatener = Left(Recherche_Concatener, Len(Recherche_Concatener) - (Taille_Colonne + 2))
End If
End Function |
Partager