XL 2013 identification dernière référence d'une famille

[erics83]

Bonjour,

J'ai un classeur avec des noms et des références. Ces références sont par familles (A,B,C,D). Je cherche à : lorsque je tape une référence (ici en H12), que le code cherche dans chaque ligne, "regarde" si la référence existe et si oui, regarde si c'est la "dernière" référence de la nomentlature.
Dans mon exemple : nom3 apparait car A001 (la référence recherchée) est la "dernière" référence dans la famille A, par contre, Nom9 (et 10) n'apparaissent pas car A001 n'est pas la "dernière" référence de la famille (A002 pour Nom9 et A009 pour Nom10)

J'aimerai passer par un code VBA, mais je ne sais pas trop comment m'y prendre....

Merci pour votre aide,
Eric,

 

[M12]

Bonjour,
Un test

 

[M12]

Re,
Une correction, n'ayant pas vu que les nomenclature pouvaient avoir plus de 4 caractères après la virgule
et cette version agit après validation de la cellule H12

 

[erics83]

Bonjour et merci M12,

Plus qu'un test, une réussite..!!! ..je ne connaissais pas ce

VBA.Right

,, mais il fonctionne parfaitement....j'étais parti sur un "découpage" de la nomentlature pour identifier le choix K12, mais apparemment

VBA.Right

le fait très bien..... je connaissais "Right", mais pas ce VBA.RIGHT..dois je en conclure, qu'il prend "automatiquement" la dernière référence "automatiquement" ? (=et que si ce n'est pas la "dernière référence", )?

Merci pour votre aide,

 

[erics83]

Re,
Une correction, n'ayant pas vu que les nomenclature pouvaient avoir plus de 4 caractères après la virgule
et cette version agit après validation de la cellule H12

Merci M12,

Mais le code bugque avec cette version : exemple (j'ai changé la nomentlature Nom1 pour voir et faire essai):

Merci pour votre aide,
Eric,

 

[chris]

Bonjour

Une fonction personnalisée à valider en matriciel

La plage est supposée être un tableau structuré

EDIT : j'ai mis la formule en I12 mais on peut la mettre où on veut.
EDIT2 : Sur 2021 et 365 cela fonctionne sans problème mais sur 2013 le matriciel n'est pas géré aussi simplement...

 

[M12]

Bonjour et merci M12,

Plus qu'un test, une réussite..!!! ..je ne connaissais pas ce

VBA.Right

,, mais il fonctionne parfaitement....j'étais parti sur un "découpage" de la nomentlature pour identifier le choix K12, mais apparemment

VBA.Right

le fait très bien..... je connaissais "Right", mais pas ce VBA.RIGHT..dois je en conclure, qu'il prend "automatiquement" la dernière référence "automatiquement" ? (=et que si ce n'est pas la "dernière référence", )?

Merci pour votre aide,

Non VBA Right, prend les dernier caractères désignés (ici j'avais mis 4) mais comme tu as des réf en 5 caractères (ex: A0011), j'ai refais une autre version, depuis mon dernier poste
qui utilise la fonction VBA Mid --> idem à STXT d'Excel

 

[erics83]

Bonjour

Une fonction personnalisée à valider en matriciel

La plage est supposée être un tableau structuré

EDIT : j'ai mis la formule en I12 mais on peut la mettre où on veut

Merci Chris,
Merci M12,

Mais comme avec le code de M12, lorsque A0011 est mis (et que j'ai changé la nomtlature de Nom1 pour faire des essais cf post 5, cela ne fonctionne pas non plus....

Merci pour votre aide,

 

[M12]

Merci M12,

Mais le code bugque avec cette version : exemple (j'ai changé la nomentlature Nom1 pour voir et faire essai):

Merci pour votre aide,
Eric,

Regarde la pièce jointe 1146942

Tu n'as bien qu'une reference se terminant par A0011

 

[chris]

RE

Voir mon edit2 : sur 2013 les fonctions matricielles nécessitent d'être saisies sur une plage et non la 1ère cellule donc cette fonction n'est adaptée qu'à 2021 ou 365 sauf à sélectionner toute la plage en jaune avant de la saisir...

 

[M12]

Tu n'as bien qu'une reference se terminant par A0011

et la modification ne se fera qu'en revalidant la cellule H12

 

[erics83]

et la modification ne se fera qu'en revalidant la cellule H12

Merci M12,
Il est possible qu'il y ait plusieures références à 5 lettres...par contre, la sélection se fera uniquement via la celulle K12.
En fait, je me dis qu'il faudrait peut-être faire un "split".....avec espace et virgule.....

Par contre, si cela peut vous "aider" ou simplifier la vie, je peux tout mettre à 5 lettres (exemple A001 deviendrait A0001).....

Merci pour votre aide,
Eric,

 

[chris]

RE
Une version VBA reprenant la fonction en sub mais le code de M12 est plus concis

On pourrait améliorer la rapidité de l'une comme l'autre en utilisant des array si le tableau source est grand

Dans le module de la feuille

Option Base 1
Sub ListeNoms(Cat As String)
Dim Liste, x As Integer
With [Nomenclature].ListObject
    ReDim Liste(1, .ListRows.Count)
    For Each Info In .ListColumns(2).DataBodyRange.Cells
        detail = Split(Info, ",")
        If detail(UBound(detail)) = Cat Then x = x + 1: Liste(1, x) = Info.Offset(0, -1).Value
    Next
    ReDim Preserve Liste(1, x)
    Range("K1:K" & .ListRows.Count).ClearContents
    Range("K1:K" & x) = WorksheetFunction.Transpose(Liste)
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [H12]) Is Nothing Then ListeNoms ([H12].Value)
End Sub

 

[erics83]

RE
Une version VBA reprenant la fonction en sub mais le code de M12 est plus concis

On pourrait améliorer la rapidité de l'une comme l'autre en utilisant des array si le tableau source est grand

Dans le module de la feuille

Option Base 1
Sub ListeNoms(Cat As String)
Dim Liste, x As Integer
With [Nomenclature].ListObject
    ReDim Liste(1, .ListRows.Count)
    For Each Info In .ListColumns(2).DataBodyRange.Cells
        detail = Split(Info, ",")
        If detail(UBound(detail)) = Cat Then x = x + 1: Liste(1, x) = Info.Offset(0, -1).Value
    Next
    ReDim Preserve Liste(1, x)
    Range("K1:K" & .ListRows.Count).ClearContents
    Range("K1:K" & x) = WorksheetFunction.Transpose(Liste)
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [H12]) Is Nothing Then ListeNoms ([H12].Value)
End Sub

Merci Chris,

Je vais tester le code...le nombre de lignes changent, (c'est pourquoi je ne pourrais pas faire une plage nommée,), il y a 60000 lignes en moyenne....

Merci,

 

[chris]

RE

Une synthèse des 2 codes utilisant des array (toujours avec une tableau structuré nommé Nomenclature)

Option Explicit
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
  If Application.Intersect(Target, Range("H12")) Is Nothing Then Exit Sub
Dim i%, j%, Pos%
Dim TS
Dim TC
    
    On Error GoTo Fin
    Application.EnableEvents = False
    Range("K:K").ClearContents
    TS = [Nomenclature].ListObject.DataBodyRange
    ReDim TC(1, UBound(TS))
      For i = 1 To UBound(TS, 1)
        Pos = InStrRev(TS(i, 2), ",") + 1
        If Mid(TS(i, 2), Pos, Len(TS(i, 2))) = Target.Value Then
          j = j + 1
          TC(1, j) = TS(i, 1)
        End If
      Next i
      ReDim Preserve TC(1, j)
      Range("K1:K" & j) = WorksheetFunction.Transpose(TC)
Fin:
      Application.EnableEvents = True
End Sub