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

Jacques25bis

XLDnaute Junior
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
 

Jacques25bis

XLDnaute Junior
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

XLDnaute Junior
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

XLDnaute Junior
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
 

Jacques25bis

XLDnaute Junior
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
 

Pièces jointes

  • Essai.xlsm
    16.5 KB · Affichages: 9

job75

XLDnaute Barbatruc
Bonjour Jacques25bis, Patrick, cp4, le forum,

Voyez le fichier joint et cette macro affectée au bouton :
VB:
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+
 

Pièces jointes

  • Validation(1).xlsm
    19.5 KB · Affichages: 10

job75

XLDnaute Barbatruc
En fait toutes les validations de données ont une propriété Formula1 donc utilisez :
VB:
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
 

Pièces jointes

  • Validation(2).xlsm
    19.9 KB · Affichages: 8

Jacques25bis

XLDnaute Junior
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
 

Pièces jointes

  • Essai.xlsm
    20.6 KB · Affichages: 2

job75

XLDnaute Barbatruc
Bonsoir,

Avec ce fichier (3) on liste toutes les formules des listes de validation :
VB:
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+
 

Pièces jointes

  • Validation(3).xlsm
    20.6 KB · Affichages: 5

merinos

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

1639428639311.png

La feuille est remplacée si elle existe deja.


VB:
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

XLDnaute Junior
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
 

Discussions similaires

Statistiques des forums

Discussions
312 799
Messages
2 092 241
Membres
105 303
dernier inscrit
dreydrette