XL 2019 Retrouver les noms utilisés dans les listes de validation

[Jacques25bis]

Bonjour à tous,

Je souhaiterai savoir s'il y a un moyen de récupérer les différents noms (formules/Gestionnaire de noms) utilisés dans les listes de validation (Outils de données/validation de données) d'un classeur.
J'aimerai détailler dans un fichier d'aide la construction de mon fichier et surtout avoir un pense bête en cas de besoin de modification.

Merci à tous.

Jack

 

[Victor21]

Bonjour, @Jacques25bis .
Gestionnaire de nom,
Dans une formule,
Coller des noms,
Coller une liste

 

[Jacques25bis]

Bonjour Victor21,

Ce que tu m'indiques c'est pour avoir la liste des zones nommées, ça c'est OK pour moi.
En revanche ce que je souhaite c'est d'avoir une liste des cellules ayant une liste de validation faisant appel à une de ces zones nommées.
Par exemple en cellule A2 j'indique dans Données/Validation de données :
Decaler(Nomfourn;equiv(aa3&"*",Nomfourn;0);;nb.si(nomfourn;AA3&"*"))

Si je fais rechercher dans les formules et que j'indique "Nomfourn" il ne m'indique pas ma cellule A2.

j'espère avoir été plus explicite.

@ plus

Jack

 

[Jacques25bis]

Rebonjour,

J'essaye de passer par une solution alternative à savoir récupérer les formules de mes listes de validation avec le code suivant mais ça ne marche pas, j'y arrive sur 1 cellule mais dès que je fais une boucle ça bloque :

Sub Macro7()
Dim myRange As Range
Dim cell As Range

Set myRange = Range("essai")

For Each cell In myRange
ActiveCell.Value = cell.Validation.Formula1
ActiveCell.Offset(1, 0).Select
Next cell

End Sub

Si vous pouvez m'aider à comprendre ;-)

@ plus

Jack

 

[Jacques25bis]

Bonjour à tous,

Je suis toujours dans mes recherches, j'ai essayé une autre approche avec une condition :

For Each cell In myRange
If cell.Validation.Formula1 <> "" Then
ActiveCell.Value = "'" & cell.Validation.Formula1
ActiveCell.Offset(1, 0).Select
End If

Next cell

Ca marche tant que la cellule a des données de validation mais dès qu'il n'y a rien j'ai un message "erreur 1004 : erreur définie par l'application ou par l'objet"

Si vous avez des idées ça m'enlèverai une bonne épine du pied (sans pour autant être sûr d'arriver à ce que je veux ;-) )

@ plus
Bonne journée.

Jack

 

[cp4]

Bonjour @Victor21 , @Jacques25bis , Le forum,

Un petit fichier, stp.

Bonne journée.

Edit: ce lien pourrait te rendre service Lien

 

[Jacques25bis]

Bonjour CP4,

Ci-joint un fichier très épuré (zone de validation en A1 et A3, zone nommée en feuille 2)

J'ai réussi à m'affranchir de l'erreur 1004 mais maintenant je voudrais qu'il ne m'indique que les cellules où il y a des données de validation (si c'est possible)

Merci pour ton aide.

@ plus

Jack

 

[job75]

Bonjour Jacques25bis, Patrick, cp4, le forum,

Voyez le fichier joint et cette macro affectée au bouton :

Sub Resultat()
Dim tablo(), n&, nom As Name, f$, P As Range, c As Range
ReDim tablo(1 To Rows.Count, 1 To 2)
tablo(1, 1) = "Nom liste"
tablo(1, 2) = "Plage"
n = 1
On Error Resume Next
For Each nom In ThisWorkbook.Names
    f = "=" & nom.Name
    Set P = Nothing
    For Each c In Cells.SpecialCells(xlCellTypeAllValidation)
        If c.Validation.Formula1 <> f Then
        Else
            Set P = Union(IIf(P Is Nothing, c, P), c)
        End If
    Next c
    If Not P Is Nothing Then
        n = n + 1
        tablo(n, 1) = nom.Name
        tablo(n, 2) = P.Address(0, 0)
    End If
Next nom
'---feuille Résultat---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Résultat").Delete
With Sheets.Add(Before:=Sheets(1))
    .Name = "Résultat"
    If n Then .[A1].Resize(n, 2) = tablo
    .Rows(1).Font.Bold = True 'gras
End With
End Sub

Les cellules étudiées sont celles de la feuille active.

A+

 

[Jacques25bis]

Salut Job75,

Ca ressemble fortement à ce que je veux, je vais éplucher le code et essayer de le comprendre et j'essayerai sur mon fichier.
Je reviendrai sans doute vers vous pour la compréhension mais en attendant un grand merci.

@ plus

Jack

 

[job75]

En fait toutes les validations de données ont une propriété Formula1 donc utilisez :

Sub Resultat()
Dim tablo(), n&, nom As Name, f$, P As Range, c As Range
ReDim tablo(1 To Rows.Count, 1 To 2)
tablo(1, 1) = "Nom liste"
tablo(1, 2) = "Plage"
n = 1
For Each nom In ThisWorkbook.Names
    f = "=" & nom.Name
    Set P = Nothing
    For Each c In Cells.SpecialCells(xlCellTypeAllValidation)
        If c.Validation.Formula1 = f Then Set P = Union(IIf(P Is Nothing, c, P), c)
    Next c
    If Not P Is Nothing Then
        n = n + 1
        tablo(n, 1) = nom.Name
        tablo(n, 2) = P.Address(0, 0)
    End If
Next nom
'---feuille Résultat---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Résultat").Delete
With Sheets.Add(Before:=Sheets(1))
    .Name = "Résultat"
    If n Then .[A1].Resize(n, 2) = tablo
    .Rows(1).Font.Bold = True 'gras
End With
End Sub

 

[Jacques25bis]

Bonjour Job75, le forum,

J'ai essayé ton code, a première vue ça marchait mais en y regardant de plus près il y a des oublis. Mon fichier exemple "essai" ne prenait pas en compte certains types de validation de donnée présent dans mon fichier à analyser.
Des 2 codes que tu m'as fourni j'ai gardé le 1er, en essayant le 2ème pour toutes les zones nommées j'avais un cellule qui revenait en permanence. Ton premier code est donc plus efficace dans mon cas.
En revanche, quand j'ai des données de validation du types :
=DECALER(Liste;EQUIV(A5&"*";Liste;0)-1;;NB.SI(Liste;A5&"*"))
et que je lance ton code il ne me prend pas en compte la zone nommée "Liste" j'ai refait mon exemple avec ce même type de donnée de validation.

Si tu vois comment améliorer le code, moi je suis encore en train de bloquer sur la compréhension.

Je te remercie par avance.

@ plus

Jack

 

[job75]

Bonsoir,

Avec ce fichier (3) on liste toutes les formules des listes de validation :

Sub Resultat()
Dim d As Object, c As Range, a, tablo(), i&, P As Range
'---liste des formules de validatuin---
Set d = CreateObject("Scripting.Dictionary")
On Error Resume Next 'si aucune SpecialCell
For Each c In Cells.SpecialCells(xlCellTypeAllValidation)
    If c.Validation.Type = xlValidateList Then d(c.Validation.Formula1) = ""
Next c
'---détermination des plages---
a = d.keys
ReDim tablo(1 To UBound(a) + 2, 1 To 2)
tablo(1, 1) = "Formule liste"
tablo(1, 2) = "Plage"
For i = 0 To UBound(a)
    Set P = Nothing
    For Each c In Cells.SpecialCells(xlCellTypeAllValidation)
        If c.Validation.Type = xlValidateList Then If c.Validation.Formula1 = a(i) Then Set P = Union(IIf(P Is Nothing, c, P), c)
    Next c
    tablo(i + 2, 1) = "'" & a(i)
    tablo(i + 2, 2) = P.Address(0, 0)
Next i
'---feuille Résultat---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Résultat").Delete
With Sheets.Add(Before:=Sheets(1))
    .Name = "Résultat"
    .[A1].Resize(UBound(tablo), 2) = tablo
    .Rows(1).Font.Bold = True 'gras
    .Columns.AutoFit 'ajuste les largeurs
End With
End Sub

A+

 

[merinos]

Salut @Jacques25bis ,


Cette macro crée une feuille avec les nom et les cellules qui s'y rapportent.
mais je ne l'emploie quasiment plus jamais.

La feuille est remplacée si elle existe deja.

Sub Create_Named_Ranges_List()

Dim rnOmrade As Range
Dim nNamn As Name
Dim lnNamn As Long, lnAntal As Long
Dim Y As Range

'************************************
' first verif is there are active names
'************************************
lnAntal = 0
For Each nNamn In ActiveWorkbook.Names
     lnAntal = lnAntal + 1
Next nNamn
If lnAntal = 0 Then
   MsgBox "Could not find any names", vbInformation, "Create Namelist"
   Exit Sub
End If


Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Namelist").Delete
ActiveWorkbook.Sheets.Add

On Error GoTo 0

'********************************
'       set columns names       *
'********************************
With ActiveSheet
       .Name = "Namelist"
       .Cells(1, 1).Value = "Name:"
       .Cells(1, 2).Value = "Value:"
       .Cells(1, 3).Value = "Refer to:"
       .Cells(1, 4).Value = "cell1:"
       .Cells(1, 5).Value = "cell2:"
       .Cells(1, 6).Value = "Start:"
       .Cells(1, 7).Value = "End:"
       With .Range("A1:G1")
              .Font.Bold = True
              .Font.ColorIndex = 10
              .Font.Size = 10
       End With
End With


lnNamn = 2
For Each nNamn In ActiveWorkbook.Names
       If nNamn.Name Like "*!Print_*" Then GoTo Fortsatt
       ActiveSheet.Cells(lnNamn, 1).Value = nNamn.Name
       ActiveSheet.Hyperlinks.Add _
                                Anchor:=ActiveSheet.Cells(lnNamn, 1), _
                                Address:="", _
                                SubAddress:=nNamn.Name
       ActiveSheet.Cells(lnNamn, 3).Value = "'" & nNamn.RefersTo
       ActiveSheet.Cells(lnNamn, 3).InsertIndent 1
       On Error Resume Next
       Set rnOmrade = nNamn.RefersToRange
       If rnOmrade.Cells.Count > 1 Then
              ActiveSheet.Cells(lnNamn, 2).Value = "Nothing"
       Else
              With ActiveSheet.Cells(lnNamn, 2)
                   .Value = nNamn.Value
                   .NumberFormat = rnOmrade.NumberFormat
              End With
       End If
       ActiveSheet.Cells(lnNamn, 4) = nNamn.RefersToRange.Address(False, False)
       ActiveSheet.Cells(lnNamn, 6).FormulaR1C1 = "=IFERROR(MID(RC[-2],2,15)/1,IFERROR(MID(rc[-2],3,15)/1,""column""))"
       ActiveSheet.Cells(lnNamn, 7).FormulaR1C1 = "=IFERROR(MID(RC[-2],2,15)/1,IFERROR(MID(rc[-2],3,15)/1,""""))"
'       ActiveSheet.Cells(lnNamn, 8).FormulaR1C1 = "=IFERROR(MID(RC[-2],2,15)/1,IFERROR(MID(rc[-2],3,15)/1,""column""))"
    
       On Error GoTo 0

       lnNamn = lnNamn + 1
Fortsatt:
Next nNamn

Set Y = ActiveSheet.Range("D2:D" & ActiveSheet.Range("D65536").End(xlUp).Row)
Y.TextToColumns Destination:=ActiveSheet.Range("D2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1))

Columns("A:C").EntireColumn.AutoFit
Columns("B").HorizontalAlignment = xlCenter
With Application
       .Calculation = xlCalculationAutomatic
       .ScreenUpdating = True
End With
'instruction eventuelle pour deleter un named range:
'nNamn.delete

End Sub  'Create_Named_Ranges_List

 

[Jacques25bis]

Salut Job75, Merinos, le forum,

Job75 j'ai essayé ton fichier 3 et pour le moment je n'ai pas le même résultat entre mon fichier de travail et mon fichier exemple, pourtant j'y ai mis le même genre de données. Il faut que je creuse.

Merinos, merci pour ton code mais finalement ça revient à faire Formules/Noms définis/Dans une formule/Coller des noms/Coller une liste en plus complet.

Au final je n'arrive toujours pas à avoir ce que je souhaite. Je vais m'inspirer de tous ces codes pour essayer d'arriver à quelque chose . Si j'arrive au bout de ce que je veux je vous tiendrai au courant.

@ plus

Jack

 

[Jacques25bis]

Re bonjour,

Une petite correction, le fonctionnement de ton fichier 3 Job75 est OK, j'ai juste pas pris le bon onglet pour ma simulation ;-)

@ plus

Jack