MerciBonjour,
Peut-être en combinant "Decaler" et "NbVal"
Bon dimanche.
OK ça marcheRe,
Sans fichier difficile d'imaginer la disposition de tes données.
une formule à adapter
=DECALER($A$22;;;;NBVAL($A$22:$M$22))
MerciComme 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.
Sub Macro1()
With Range("B5:B21").Validation
.Delete
.Add xlValidateList, Formula1:="=OFFSET(Feuil2!$A5,,1,,COUNTA(Feuil2!5:5))"
End With
End Sub
C'est cela et sans fautesBonjour 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 job75Bonjour 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
With Range("F2:F" & dlig).Validation
.Delete
.Add xlValidateList, Formula1:="=OFFSET(A!$F2,,1,,COUNTIF(A!2:2,""><"")-COUNTIF(A!A2:F2,""><""))"
End With
MERCI Je vais y travaillerDans la macro etablir_ utilisez :
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.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
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
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.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 :
La macro est bien sûr très rapide puisqu'une seule liste de validation est créée à chaque sélection en colonne F.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
A+
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).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.