XL 2019 problème sur macro de calcul sans doublon

rh.finances

XLDnaute Junior
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
 

Pièces jointes

  • calcul sans doublon.xls
    177 KB · Affichages: 7
Solution
Bonjour à tous,

Essayez :
VB:
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 ;)

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Essayez :
VB:
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 ;)
 
Dernière édition:

rh.finances

XLDnaute Junior
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

XLDnaute Barbatruc
Bonjour rh.finances, Bruno, mapomme,

Avec RemoveDuplicates :
VB:
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+
 

Pièces jointes

  • calcul sans doublon.xls
    176 KB · Affichages: 4

Discussions similaires

Réponses
6
Affichages
263

Statistiques des forums

Discussions
302 327
Messages
2 002 589
Membres
215 663
dernier inscrit
asasdek