Aide! Macro rechercher valeurs similaires dans chaque colonne d'un tableau et suppr

[charbo57]

Bonjour à tous,

étant novice sur Excel, je me retrouve confronté à un problème de poids lors de l'élaboration d'une macro sur ce logiciel. J'espère que vous pourrez m'aider.

Je possède quatre feuilles contenant chacune 1 tableau de 80 colonnes et de 600 lignes. Je souhaiterai chercher dans les colonnes de ce tableau les valeurs qui se répètent trop souvent pour les supprimer.

En langage informatique, cela donnerait quelque chose du genre :

"pour la feuille active"

%initialisation
colonne_debut = 1
colonne_fin = 80
ligne_debut = 3
ligne_fin = 630

% pour chaque colonne, je balaye :
for i = colonne_debut to colonne_fin
limite = 0;
% pour chaque ligne, je regarde si la valeur de la cellule concernée se répète
for j = ligne_debut to ligne_fin
%pour chaque cellule concernée, je balaye les autres cellules de la colonne
for k = ligne_debut to ligne_fin
if valeurcellule(i,j) = valeurcellule(i,k)
limite = limite + 1;
% si + de 8 valeurs similaires, on les supprime
if limite >= 8
delcellule(i,*) = 'valeurcellule(i,j)' % action de supprimer (avec Selection.ClearContents? 😕 )
end
end
end
end
end

j'espère que vous m'avez suivi ^^, malheureusement, je ne connais pas très bien les équivalences pour le VBA et je n'arrive pas du tout à l'enregistrer de manière manuelle.

Merci pour votre aide et bonne fin de week-end

 

[pierrejean]

Re : Aide! Macro rechercher valeurs similaires dans chaque colonne d'un tableau et su

Bonjour charbo57

Et bienvenue sur XLD

Compte tenu du grand nombre de données je pense qu'il faut travailler avec dictionnaire et Tableau

A tester:

Sub suppr()
tablo = Range("A1:CB600") 'a adapter
For m = LBound(tablo, 2) To UBound(tablo, 2)
Set dico = CreateObject("Scripting.dictionary")
  For n = LBound(tablo, 1) To UBound(tablo, 1)
    x = tablo(n, m)
    If x <> "" Then dico(x) = dico(x) & n & ":" & m & ";"
  Next
  a = dico.keys
  b = dico.items
  For p = LBound(a) To UBound(a)
    Z = Split(b(p), ";")
    If UBound(Z) > 7 Then
      For q = LBound(Z) To UBound(Z) - 1
        zz = Split(Z(q), ":")
        tablo(zz(0), zz(1)) = ""
      Next
    End If
  Next
Next
Range("A1").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo 'A1 à adapter
End Sub

 

[charbo57]

Re : Aide! Macro rechercher valeurs similaires dans chaque colonne d'un tableau et su

Super c'est exactement ce que je cherchais! Merci beaucoup pour votre rapidité, et bonne soirée! 😀

 

[pierrejean]

Re : Aide! Macro rechercher valeurs similaires dans chaque colonne d'un tableau et su

Re

La nuit portant conseil: Une version simplifiée

Sub suppr()
tablo = Range("A1:CB600") 'a adapter
For m = LBound(tablo, 2) To UBound(tablo, 2)
Set dico = CreateObject("Scripting.dictionary")
  For n = LBound(tablo, 1) To UBound(tablo, 1)
    x = tablo(n, m)
    If x <> "" Then dico(x) = dico(x) & n & ";"
  Next
  a = dico.keys
  b = dico.items
  For p = LBound(a) To UBound(a)
    Z = Split(b(p), ";")
    If UBound(Z) > 7 Then
      For q = LBound(Z) To UBound(Z) - 1
        tablo(Z(q), m) = ""
      Next
    End If
  Next
Next
Range("A1").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo 'A1 à adapter
End Sub