XL 2019 problème sur macro de calcul sans doublon

[rh.finances]

Bonsoir à tous les internautes de ce forum,

je me permets de vous solliciter car étant peu aguerri au langage VBA, je n'arrive pas à résoudre un petit problème pour un calcul sans doublon :

j'ai récupéré sur un forum une macro de calcul sans doublon qui fonctionne sur un autre fichier Excel mais pas sur le fichier Excel joint.

pour résumer, j'ai une liste de nom en colonne B que je souhaite copier-coller sans doublon dans un tableau en J2:J20 (nommé "synthèse_tableau").
j'ai appliqué une macro dans un "module 1" et j'ai affecté la macro en question dans une icone nommée "calculer" figurant dans la feuille Excel.
et quand je lance le calcul, j'ai une "erreur d'exécution 1004" car il semble que ma colonne B pose problème.

Aussi, si une âme charitable veut bien m'aiguiller sur le problème rencontré, ce serait vraiment sympa car là, j'avoue que je bloque !!

merci d'avance et bonne soirée à tou(te)s

Alexandre

 

[Compte Supprimé 979]

Bonsoir Alexandre,

Si vous avez O365, mieux vaut utiliser la fonction UNIQUE()

En J2, mettre :

=UNIQUE(B2:B24)

A+

 

[mapomme]

Bonjour à tous,

Essayez :

Public Sub Actualiser()
Dim sh1 As Worksheet, sh2 As Worksheet, dico, a, i As Long
   Application.ScreenUpdating = False
   Set sh1 = Feuil2: Set sh2 = Feuil2
   Set dico = CreateObject("Scripting.Dictionary")
   With sh1
      If .FilterMode Then .ShowAllData
      a = .Range("b2:b" & .Cells(Rows.Count, "b").End(xlUp).Row)
      For i = LBound(a) To UBound(a): dico(a(i, 1)) = "": Next
   End With
   With sh2.Range("j2")
      .Resize(sh2.Rows.Count - 1).ClearContents
      .Resize(dico.Count) = Application.Transpose(dico.keys)
   End With
End Sub

nota : Bonjour @job75

 

[rh.finances]

Bonjour Bruno, Bonjour MaPomme,

tout d'abord, merci à vous deux pour vous être penchés sur mon cas !

Bruno, je n'ai malheureusement pas Office 365 mais je pense que je vais me l'offrir pour Noël

MaPomme, la solution proposée est parfaite. ca fonctionne comme je le souhaite !!

Encore merci à vous pour votre aide !!
bonne journée et bon week-end !

 

[job75]

Bonjour rh.finances, Bruno, mapomme,

Avec RemoveDuplicates :

Sub Actualiser()
    Application.ScreenUpdating = False
    Columns("J").ClearContents 'RAZ
    Columns("K").Insert 'colonne auxiliaire pour ne pas toucher aux formats
    With [A1].CurrentRegion.Columns("B")
        .Copy [K1]
        [K1].Resize(.Rows.Count).RemoveDuplicates 1, Header:=xlYes 'supprime les doublons
        [J1].Resize(.Rows.Count) = [K1].Resize(.Rows.Count).Value 'copie les vakeurs
    End With
    Columns("K").Delete
End Sub

A+

 

[rh.finances]

Bonjour Job75 et merci également pour ce retour !
je suis gâté : j'ai 2 solutions qui fonctionnent parfaitement et même une 3ème solution possible en faisant l'acquisition d'office365.
bon week-end

Alex