Validation de données liste dynamique

KTM

XLDnaute Impliqué
Salut le Forum
J'aimerais savoir quelle formule utiliser dans ma fenêtre de validation de données pour rendre ma liste dynamique
1er Cas - Mes données sont disposées sur la meme ligne
2eme Cas -Mes données sont disposées dans la meme colonne
Merci .
 

KTM

XLDnaute Impliqué
Re,

Sans fichier difficile d'imaginer la disposition de tes données.

une formule à adapter
=DECALER($A$22;;;;NBVAL($A$22:$M$22))
OK ça marche
j'ai utilisé pour concevoir cette macro mais une erreur me revient.
Pouvez vous m'aider à résoudre ? Merci

With Range("Q2").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=DECALER(A!$F$2;0;1;NBVAL(A!$2:$2))"

.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
 

cp4

XLDnaute Barbatruc
Comme signalé dans le post#4, il ne m'est pas possible de t'aider sans fichier joint.
Cependant, je te joint un fichier où tu trouveras un exemple à adapter à ton cas.
nb: il y a 2 modules, un standard et un module de feuille (feuil1).

Bonne continuation. Je dois sortir pour la journée.
 

Pièces jointes

  • Creer Listes Validations.xlsm
    19.6 KB · Affichages: 23

KTM

XLDnaute Impliqué
Comme signalé dans le post#4, il ne m'est pas possible de t'aider sans fichier joint.
Cependant, je te joint un fichier où tu trouveras un exemple à adapter à ton cas.
nb: il y a 2 modules, un standard et un module de feuille (feuil1).

Bonne continuation. Je dois sortir pour la journée.
Merci
Je joins un fichier test pour illustrer mon soucis
 

Pièces jointes

  • cLSS.xlsm
    16.4 KB · Affichages: 9

job75

XLDnaute Barbatruc
Bonjour KTM, cp4, le forum,

Pour le fichier du post précédent :
VB:
Sub Macro1()
With Range("B5:B21").Validation
    .Delete
    .Add xlValidateList, Formula1:="=OFFSET(Feuil2!$A5,,1,,COUNTA(Feuil2!5:5))"
End With
End Sub
 

KTM

XLDnaute Impliqué
Bonjour KTM, cp4, le forum,

Pour le fichier du post précédent :
VB:
Sub Macro1()
With Range("B5:B21").Validation
    .Delete
    .Add xlValidateList, Formula1:="=OFFSET(Feuil2!$A5,,1,,COUNTA(Feuil2!5:5))"
End With
End Sub
A propos cher job75
Avec votre precieuse aide vous m'avez permis de finaliser un projet sur lequel je bosse depuis quelques temps
1-Vous m'avez offert une formule géniale que j'ai pu mettre a profit
2- ce bout de code de validation de données qui est super bien
J'ai avec ce melange elaborer une macro qui fonctionne comme suit dans mon fichier joint:
- Dans la colonne F une liste déroulantes de sites ayant un état de stock approprié:
*Par exemple en face de chaque produit en rupture on liste toutes les structures en Surstock ou Stock Dormant
*En face de chaque produit en Surstock ou Stock Dormant on liste toutes les structures en Rupture

Ma préoccupation actuelle c'est que ma vraie base de données est volumineuse , 25000 lignes et ma macro prend six minutes pour s'exécuter
Je voudrais l'optimiser avec votre aide.
Ci joint mon fichier test.
Merci Encore pour tout.
 

Pièces jointes

  • Essai.xlsm
    51 KB · Affichages: 11

job75

XLDnaute Barbatruc
Dans la macro etablir_ utilisez :
VB:
With Range("F2:F" & dlig).Validation
    .Delete
    .Add xlValidateList, Formula1:="=OFFSET(A!$F2,,1,,COUNTIF(A!2:2,""><"")-COUNTIF(A!A2:F2,""><""))"
End With
Quant au problème du temps de calcul sur 25000 lignes c'est simple : VBA permettra d'aller vite à condition de ne pas utiliser des formules matricielles en colonnes G et suivantes et d'utiliser des variables tableau VBA.
 

KTM

XLDnaute Impliqué
Dans la macro etablir_ utilisez :
VB:
With Range("F2:F" & dlig).Validation
    .Delete
    .Add xlValidateList, Formula1:="=OFFSET(A!$F2,,1,,COUNTIF(A!2:2,""><"")-COUNTIF(A!A2:F2,""><""))"
End With
Quant au problème du temps de calcul sur 25000 lignes c'est simple : VBA permettra d'aller vite à condition de ne pas utiliser des formules matricielles en colonnes G et suivantes et d'utiliser des variables tableau VBA.
MERCI Je vais y travailler
 

job75

XLDnaute Barbatruc
Bonjour KTM,

En fait je vous ai déjà donné une solution VBA complète ici :

https://www.excel-downloads.com/threads/gerer-base-de-donnees.20029526/#post-20220843

Donc voyez le fichier joint, j'ai un peu amélioré la macro :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Columns(7).Resize(, Columns.Count - 6).ClearContents 'RAZ
[F:F].Validation.Delete 'RAZ
If ActiveCell.Column <> 6 Or ActiveCell.Row = 1 Then Exit Sub
If ActiveCell(1, 0) = "" Then Exit Sub
Dim x, h&, ligdeb&, d1 As Object, d2 As Object, i&
With [A1].CurrentRegion.Resize(, 7)
    x = .Cells(ActiveCell.Row, 4)
    h = Application.CountIf(.Columns(4), x)
    If h = 0 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Columns(7).Insert 'colonne auxiliaire
    .Cells(1, 7) = 1: .Columns(7).DataSeries 'numérotation
    .Sort .Columns(4), Header:=xlYes 'tri sur la colonne D
    ligdeb = Application.Match(x, .Columns(4), 0)
    Set d1 = CreateObject("Scripting.Dictionary")
    d1.Comparemode = vbTextCompare 'la casse est ignorée
    Set d2 = CreateObject("Scripting.Dictionary")
    d2.Comparemode = vbTextCompare 'la casse est ignorée
    For i = ligdeb To ligdeb + h - 1
        If UCase(.Cells(i, 5)) = "RUPTURE" Then d1(.Cells(i, 1).Value) = "" Else d2(.Cells(i, 1).Value) = ""
    Next
    .Sort .Columns(7), xlAscending, Header:=xlYes 'ordre initial
End With
Columns(7).Delete
With IIf(UCase(ActiveCell(1, 0)) = "RUPTURE", d2, d1)
    If .Count Then
        ActiveCell(1, 2).Resize(, .Count) = .keys
        ActiveCell.Validation.Add xlValidateList, Formula1:="=" & ActiveCell(1, 2).Resize(, .Count).Address
    End If
End With
Application.EnableEvents = True
End Sub
La macro est bien sûr très rapide puisqu'une seule liste de validation est créée à chaque sélection en colonne F.

A+
 

Pièces jointes

  • Essai(1).xlsm
    25 KB · Affichages: 12

KTM

XLDnaute Impliqué
Bonjour KTM,

En fait je vous ai déjà donné une solution VBA complète ici :

https://www.excel-downloads.com/threads/gerer-base-de-donnees.20029526/#post-20220843

Donc voyez le fichier joint, j'ai un peu amélioré la macro :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Columns(7).Resize(, Columns.Count - 6).ClearContents 'RAZ
[F:F].Validation.Delete 'RAZ
If ActiveCell.Column <> 6 Or ActiveCell.Row = 1 Then Exit Sub
If ActiveCell(1, 0) = "" Then Exit Sub
Dim x, h&, ligdeb&, d1 As Object, d2 As Object, i&
With [A1].CurrentRegion.Resize(, 7)
    x = .Cells(ActiveCell.Row, 4)
    h = Application.CountIf(.Columns(4), x)
    If h = 0 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Columns(7).Insert 'colonne auxiliaire
    .Cells(1, 7) = 1: .Columns(7).DataSeries 'numérotation
    .Sort .Columns(4), Header:=xlYes 'tri sur la colonne D
    ligdeb = Application.Match(x, .Columns(4), 0)
    Set d1 = CreateObject("Scripting.Dictionary")
    d1.Comparemode = vbTextCompare 'la casse est ignorée
    Set d2 = CreateObject("Scripting.Dictionary")
    d2.Comparemode = vbTextCompare 'la casse est ignorée
    For i = ligdeb To ligdeb + h - 1
        If UCase(.Cells(i, 5)) = "RUPTURE" Then d1(.Cells(i, 1).Value) = "" Else d2(.Cells(i, 1).Value) = ""
    Next
    .Sort .Columns(7), xlAscending, Header:=xlYes 'ordre initial
End With
Columns(7).Delete
With IIf(UCase(ActiveCell(1, 0)) = "RUPTURE", d2, d1)
    If .Count Then
        ActiveCell(1, 2).Resize(, .Count) = .keys
        ActiveCell.Validation.Add xlValidateList, Formula1:="=" & ActiveCell(1, 2).Resize(, .Count).Address
    End If
End With
Application.EnableEvents = True
End Sub
La macro est bien sûr très rapide puisqu'une seule liste de validation est créée à chaque sélection en colonne F.

A+
Je voudrais savoir comment on agencerait le code au cas ou la colonne F serait à l'intérieur de ma table et non a la fin.
Merci pour tout
 

Pièces jointes

  • Essai(1)bis.xlsm
    22.6 KB · Affichages: 3

job75

XLDnaute Barbatruc
Je voudrais savoir comment on agencerait le code au cas ou la colonne F serait à l'intérieur de ma table et non a la fin.
Pour la nouvelle feuille du fichier joint j'ai juste adapté la RAZ en début de macro et remplacé à la fin ActiveCell(1, 2) par ActiveCell(1, 4).
 

Pièces jointes

  • Essai(1 bis).xlsm
    28.3 KB · Affichages: 5
Dernière édition:

Discussions similaires

Réponses
8
Affichages
364

Statistiques des forums

Discussions
311 725
Messages
2 081 939
Membres
101 844
dernier inscrit
pktla