XL 2019 problème sur macro de calcul sans doublon

rh.finances · 2 Septembre 2022

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

mapomme · 3 Septembre 2022

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

Compte Supprimé 979 · 2 Septembre 2022

Bonsoir Alexandre,

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

En J2, mettre :

VB:

=UNIQUE(B2:B24)

A+

mapomme · 3 Septembre 2022

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

rh.finances · 3 Septembre 2022

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 · 3 Septembre 2022

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+

rh.finances · 3 Septembre 2022

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

XL 2019 problème sur macro de calcul sans doublon

rh.finances

XLDnaute Occasionnel

Pièces jointes

mapomme

Compte Supprimé 979

Guest

mapomme

XLDnaute Barbatruc

rh.finances

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

rh.finances

XLDnaute Occasionnel

Discussions similaires