web-dev-qa-db-fra.com

Comment obtenir une liste de valeurs uniques d'une plage dans Excel VBA?

Je souhaite obtenir une liste de valeurs uniques dans une plage utilisant VBA. La plupart des exemples de Google parlent d'obtenir une liste de valeurs uniques dans une colonne à l'aide de VBA.

Je ne suis pas sûr de savoir comment le changer pour obtenir une liste de valeurs dans une plage. 

Par exemple,

Currency    Name 1  Name 2  Name 3  Name 4  Name 5
SGD BGN DBS         
PHP PDSS                
KRW BGN             
CNY CBBT    BGN         
IDA INPC

Mon tableau devrait ressembler à:

BGN, DBS, PDSS, CBBT and INPC.

Comment fait-on ça? Besoin de conseils.

excelvbaexcel-vba
6
lakesh

Je voudrais utiliser un simple VBA-Collection et ajouter des éléments avec la clé. La clé serait l'élément lui-même et, comme il ne peut pas y avoir de clés duplicites, la collection contiendra des valeurs uniques.

Remarque: Étant donné que l'ajout d'une clé duplicit à la collection génère une erreur, encapsulez l'appel de collection-add dans un on-error-resume-next. 

La fonction GetUniqueValues a source-range-values ​​ comme paramètre et relance VBA-Collection de unique source-range-values ​​. Dans la méthode main, la fonction est appelée et le résultat est imprimé dans la fenêtre de sortie. HTH.

La plage de sources d'échantillonnage ressemblait à ceci:  enter image description here 

Option Explicit

Sub main()
    Dim uniques As Collection
    Dim source As Range

    Set source = ActiveSheet.Range("A2:F6")
    Set uniques = GetUniqueValues(source.Value)

    Dim it
    For Each it In uniques
        Debug.Print it
    Next
End Sub

Public Function GetUniqueValues(ByVal values As Variant) As Collection
    Dim result As Collection
    Dim cellValue As Variant
    Dim cellValueTrimmed As String

    Set result = New Collection
    Set GetUniqueValues = result

    On Error Resume Next

    For Each cellValue In values
        cellValueTrimmed = Trim(cellValue)
        If cellValueTrimmed = "" Then GoTo NextValue
        result.Add cellValueTrimmed, cellValueTrimmed
NextValue:
    Next cellValue

    On Error GoTo 0
End Function

Sortie

SGD
PHP
KRW
CNY
IDA
BGN
PDSS
CBBT
INPC
DBS
a

Dans le cas où la plage source est composée de zones, obtenez les valeurs de toutes les zones en premier.

Public Function GetSourceValues(ByVal sourceRange As Range) As Collection
    Dim vals As VBA.Collection
    Dim area As Range
    Dim val As Variant
    Set vals = New VBA.Collection
    For Each area In sourceRange.Areas
        For Each val In area.Value
            If val <> "" Then _
                vals.Add val
        Next val
    Next area
    Set GetSourceValues = vals
End Function

Le type de source est maintenant Collection mais tous fonctionnent de la même manière:

Dim uniques As Collection
Dim source As Collection

Set source = GetSourceValues(ActiveSheet.Range("A2:F6").SpecialCells(xlCellTypeVisible))
Set uniques = GetUniqueValues(source)
10
dee

En boucle dans la plage, vérifiez si la valeur est dans le tableau, sinon ajoutez-le au tableau. 

Sub test()
Dim Values() As Variant
Values = GetUniqueVals(Selection)
Dim i As Integer
    For i = LBound(Values) To UBound(Values)
        Debug.Print (Values(i))
    Next

End Sub

Function GetUniqueVals(ByRef Data As Range) As Variant()
    Dim cell As Range
    Dim uniqueValues() As Variant
    ReDim uniqueValues(0)

    For Each cell In Data
        If Not IsEmpty(cell) Then
            If Not InArray(uniqueValues, cell.Value) Then
                If IsEmpty(uniqueValues(LBound(uniqueValues))) Then
                    uniqueValues(LBound(uniqueValues)) = cell.Value
                Else
                    ReDim Preserve uniqueValues(UBound(uniqueValues) + 1)
                    uniqueValues(UBound(uniqueValues)) = cell.Value
                End If
            End If
        End If
    Next
    GetUniqueVals = uniqueValues
End Function

Function InArray(ByRef SearchWithin() As Variant, ByVal SearchFor As Variant) As Boolean
    Dim i As Integer
    Dim matched As Boolean 'Default value of boolean is false, we make true only if we find a match

    For i = LBound(SearchWithin) To UBound(SearchWithin)
        If SearchWithin(i) = SearchFor Then matched = True
    Next

    InArray = matched
End Function
0
CBRF23