Function PutUniqueValue(oList As ListObject, ColumnLabel AsString)As Range
' Philippe Tulliez www.magicoffice.be' Date 12-01-2020' Version 1.1' Arguments' oList Tableau source' ColumnLabel Nom de l'étiquette de la colonne dont on veut extraire les valeurs uniques' DéclarationDim rngColumn As Range ' Plage de la colonne de l'argument ColumnLabelDim rngTarget As Range ' Cellule cible où aura lieu l'exportation de la liste (2ème colonne à gauche de la source)' AssignationWith oList.Range
Set rngTarget = .Offset(ColumnOffset:=.Columns.Count + 1).Resize(1, 1)EndWith
rngTarget.Value = ColumnLabel
With oList
Set rngColumn = .ListColumns(ColumnLabel).Range.Resize(.Range.Rows.Count - Abs(.ShowTotals))EndWith' Exportation sans les doublons
rngColumn.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rngTarget, Unique:=True' Objet renvoyé par la fonctionSet PutUniqueValue = rngTarget.CurrentRegion
' Fin de la procédureSet rngTarget = Nothing: Set rngColumn = NothingEndFunction
Code de la procédure invoquant cette procédure
Cette procédure de test exporte toutes les valeurs, sans les doublons, contenues dans la colonne Région du tableau structuré nommé T_Sales et affiche dans un MsgBox la liste exportée après l'avoir supprimée
Sub TestPutUniqueValue()Const TableSourceName AsString = "T_Sales"Const LabelName AsString = "Région"Dim sht As Worksheet
Dim oListSource As ListObject
Dim rngSource As Range
Dim areaUniqueValue As Range
Dim Cell As Range
Dim msg AsString'Set sht = GetListObjectSheet(TableSourceName, ThisWorkbook)Set oListSource = sht.ListObjects(TableSourceName)Set areaUniqueValue = PutUniqueValue(oListSource, LabelName)With areaUniqueValue
ForEach Cell In .Offset(1).Resize(.Rows.Count - 1)
msg = msg & vbCrLf & Cell.Address & vbTab & Cell.Value
Next
.Clear ' On efface la plage après traitementEndWith
MsgBox msg
' Fin de processSet oListSource = Nothing: Set rngSource = Nothing: Set areaUniqueValue = Nothing: Set Cell = NothingEndSub
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité,
merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.