Recherche & référence UNIQUEx

patricktoulon à dit:

Bonjour a tous dans la lignée de DicoCountOrder
ne l'ayant pas parce que je suis 2013 je vous propose aujourd'hui la petite( UNIQUEx)
qui fait exactement ce que fait la fonction UNIQUE de 2016 et +
elle travaille sur 2 ou 1 colonne dans la récupération et peut filtrer par la colonne 1 ou 2
Regarde la pièce jointe 1130290

VB:

'***************************************************************************
'                 Collection fonction doublons                             *
' Fonction "UNIQUEx"                                                       *
' filter les doublons d'une plage de deux colonnes par la colonne (1 ou 2) *
' fonctionne comme son homologue "UNIQUE" des versions superieur  à 2013   *
' auteur :patricktoulon                                                    *
' date 09/02/2022                                                          *
' version 1.0                                                              *
'***************************************************************************

Option Explicit
Function UNIQUEx(RNG As Range, Optional col& = 0)
    Dim T, dic As Object, I&, t2, K, It, kx, itX, Col2: T = RNG.Value
    Set dic = CreateObject("Scripting.Dictionary")
    If col = 0 Then col = 1
    If col = 1 Then Col2 = 2 Else Col2 = 1
    T = RNG.Resize(RNG.Rows.Count, 2)
    For I = 1 To UBound(T): dic(T(I, col)) = T(I, Col2): Next: K = dic.keys: It = dic.items: kx = K: itX = It
    If col = 2 Then kx = It: itX = K
    ReDim t2(1 To Application.Caller.Rows.Count, 1 To 2)
    For I = 1 To UBound(t2)
        If I <= UBound(kx) + 1 Then t2(I, 1) = kx(I - 1): t2(I, 2) = itX(I - 1) Else t2(I, 1) = "": t2(I, 2) = ""
    Next
    UNIQUEx = t2
End Function


Sub UnregisterOptions()
    On Error Resume Next
    Application.MacroOptions Macro:="UNIQUEx", Description:=Empty, ArgumentDescriptions:=Empty, Category:=Empty
    On Error GoTo 0
End Sub

Sub registerOptions()
    Dim Funct_description As String, argumtsArray

    '(max 255 caracteres)
    Funct_description = "Fonction UNIQUEx " & vbCrLf & _
                        "Filtre doublons dans une plage 1/2 colonnes par la colonne 1 ou 2" & vbCrLf & _
                        "Remplace la fonction UNIQUE de 2016 et +" & vbCrLf & _
                        "Elle fonctionne aussi comme La  UNIQUE(2016+)1 colonne" & vbCrLf & vbCrLf & _
                        "Collection Fonctions Persos Créated By patricktoulon 02/2022"

    'Description des arguments de la fonction
    argumtsArray = Array("Adresse de la colonne à trier ", _
                         "index de la colonne à extraire les doublons ")


    'appel  la sub pour enregistrer
    Application.MacroOptions Macro:="UNIQUEx", _
                             Description:=Mid(Funct_description, 1, 255), _
                             ArgumentDescriptions:=argumtsArray, _
                             Category:="personnalisée"
End Sub


'***************************************
'a mettre dans l'open si on veut la description  et le formulaire de fonction
Sub auto_open(): registerOptions: End Sub
Sub auto_close(): UnregisterOptions: End Sub
'***************************************

Cliquez pour agrandir...

patricktoulon à dit:

Bonjour Etoto merci
a bon elle n'y est pas sur 2016 ?
je pensais qu'elle y était déjà sur 2016
ben ravi pour toi

ps: a oui je viens de lire sur le suport MS qu'elle n'est actuellement disponible que sur 365

Cliquez pour agrandir...