stephsteph
XLDnaute Occasionnel
Bonjour,
J'ai trouvé dans ce fil...
https://www.excel-downloads.com/thr...ages-noms-definies-avec-une-condition.209615/
une macro qui me convient et je l'ai adaptée comme ci-après...
Elle fonctionne (c'est encore plus simple, il n'y a qu'une seule colonne), les champs sont créés... mais ils ne vont pas de la 1ère à la dernière ligne concernée, ils ne contiennent chacun que la dernière ligne (soit une seule cellule).
Des pistes s'il vous plait... cela doit me sauter aux yeux mais j'ai trituré pas mal, et je déclare forfait.
Merci, Steph
Sub Fieldsabstracts()
'
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim d As Object 'déclare la variable d (Dictionnaire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim tmp As Variant 'déclare la variable tmp (tableau TeMPoraire)
Dim tp() As Range 'déclare le tableau de variables indéxées tp (Tableau des Plages)
Dim n() As String 'déclare le tableau de variables indéxées n (tableau des Noms)
Dim x As Integer 'déclare la variable x
Set o = Sheets("abstracts") 'définit l'onglet o
dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
Set pl = o.Range("A1:A" & dl) 'définit la plage pl
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionnaire d
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
If cel.Value <> "" Then d(cel.Value) = "" 'alimente le dictionnaire des cellules non vides
Next cel 'prochaine cellule cel de la plage pl
tmp = d.keys 'récupère la liste sans doublons dans le tableau temporaire tmp
ReDim tp(d.Count) 'redimensionne le tableau des plages tp
ReDim n(d.Count) 'redimensionne le tableau des nom n
For x = 0 To UBound(tmp) 'boucles sur toutes les valeurs uniques du tableau tmp
Set tp(x) = Range("A1") 'pré définit la plage tp(x)
For Each cel In pl 'boucle 2 sur toutes les cellules de la plage pl
If cel.Value = tmp(x) Then 'condition : si la valeur de la cellule est égale à la valeur unique du tableau tmp
'définit la plage tp(x)
Set tp(x) = IIf(tp(x).Cells.Count = 1, o.Cells(cel.Row, 2).Resize(1, 1), Application.Union(tp(x), o.Cells(cel.Row, 2).Resize(1, 1)))
' 2 correspond à la colonne de départ et le 2ème 1 de resize le nombre de colonnes jusqu'à la dernière du champ
n(x) = cel.Offset(0, 0).Value 'définit le nom n(x)
' alternative n(x) = o.Cells(cel.Row, 7).Value si pas contiguë
End If 'fin de la condition
Next cel 'prochaine cellule de la plage
tp(x).Name = " __" & n(x) 'attribue le nom n(x) à la plage tp(x)
Next x 'prochaine valeur unique du tableau tmp
End Sub
J'ai trouvé dans ce fil...
https://www.excel-downloads.com/thr...ages-noms-definies-avec-une-condition.209615/
une macro qui me convient et je l'ai adaptée comme ci-après...
Elle fonctionne (c'est encore plus simple, il n'y a qu'une seule colonne), les champs sont créés... mais ils ne vont pas de la 1ère à la dernière ligne concernée, ils ne contiennent chacun que la dernière ligne (soit une seule cellule).
Des pistes s'il vous plait... cela doit me sauter aux yeux mais j'ai trituré pas mal, et je déclare forfait.
Merci, Steph
Sub Fieldsabstracts()
'
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim d As Object 'déclare la variable d (Dictionnaire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim tmp As Variant 'déclare la variable tmp (tableau TeMPoraire)
Dim tp() As Range 'déclare le tableau de variables indéxées tp (Tableau des Plages)
Dim n() As String 'déclare le tableau de variables indéxées n (tableau des Noms)
Dim x As Integer 'déclare la variable x
Set o = Sheets("abstracts") 'définit l'onglet o
dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
Set pl = o.Range("A1:A" & dl) 'définit la plage pl
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionnaire d
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
If cel.Value <> "" Then d(cel.Value) = "" 'alimente le dictionnaire des cellules non vides
Next cel 'prochaine cellule cel de la plage pl
tmp = d.keys 'récupère la liste sans doublons dans le tableau temporaire tmp
ReDim tp(d.Count) 'redimensionne le tableau des plages tp
ReDim n(d.Count) 'redimensionne le tableau des nom n
For x = 0 To UBound(tmp) 'boucles sur toutes les valeurs uniques du tableau tmp
Set tp(x) = Range("A1") 'pré définit la plage tp(x)
For Each cel In pl 'boucle 2 sur toutes les cellules de la plage pl
If cel.Value = tmp(x) Then 'condition : si la valeur de la cellule est égale à la valeur unique du tableau tmp
'définit la plage tp(x)
Set tp(x) = IIf(tp(x).Cells.Count = 1, o.Cells(cel.Row, 2).Resize(1, 1), Application.Union(tp(x), o.Cells(cel.Row, 2).Resize(1, 1)))
' 2 correspond à la colonne de départ et le 2ème 1 de resize le nombre de colonnes jusqu'à la dernière du champ
n(x) = cel.Offset(0, 0).Value 'définit le nom n(x)
' alternative n(x) = o.Cells(cel.Row, 7).Value si pas contiguë
End If 'fin de la condition
Next cel 'prochaine cellule de la plage
tp(x).Name = " __" & n(x) 'attribue le nom n(x) à la plage tp(x)
Next x 'prochaine valeur unique du tableau tmp
End Sub
Dernière édition:
!
