Supprimer des doublons consécutifs

Bonjour ou rebonjour tout le monde,

Dans ce nouveau topic, j'ai une question simple à poser au forum, et qui me retourne l'esprit depuis deux jours maintenant : je sais qu'on peut supprimer les doublons d'une colonne. Mais est-il possible de ne supprimer que les doublons consécutifs ? Je m'explique : si dans une colonne j'ai 60 ; 30 ; 60 ; 0 ; 60 ; 60 ; 60 ; 30 ; 0, comment est-ce que je peux faire en VBA pour obtenir 60 ; 30 ; 60 ; 0 ; 60 ; 0, c'est-à-dire ne garder que la première valeur d'une série de doublons consécutifs ?

J'agrément ma demande avec un petit fichier, qui je l'espère facilitera la compréhension de ma demande.

En vous remerciant par avance, je vous souhaite un agréable mercredi.

Rod'

18classeur3.xlsm (10.73 Ko)

Bonjour Rododom, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim O As Worksheet 'déclare la varaible O (Onglet)
Dim TV As Variant 'déclare la varaible TV (Tableau des Valeurs)
Dim I As Integer 'déclare la varaible I (Incrément)
Dim TL() As Variant 'déclare la varaible TL (Taleau des Lignes)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("C4").CurrentRegion 'définit le tableau des valeurs TV
ReDim Preserve TL(1 To 2, 1 To 1) 'redimensione le tableau de lignes TV (2 lignes, 1 colonne)
TL(1, 1) = TV(2, 1) 'récupère dans la première ligne la donnée ligne 2 colonne 1 de TV
TL(2, 1) = TV(2, 2) 'récupère dans la seconde ligne la donnée ligne 2 colonne 2 de TV
k = 2 'initialise la varaible K
For I = 2 To UBound(TV, 1) - 1 'boucle sur toutes les lignes I du tableau des valeurs TV (de la seconde à l'avant dernière)
    If CInt(TV(I, 2)) <> CInt(TV(I + 1, 2)) Then 'condition : si la donnée ligne I, colonne 2 de TV est différente de la donnée ligne I+1 colonne de de TV (les deux converties en entier)
        ReDim Preserve TL(1 To 2, 1 To k) 'redimensione le tableau de lignes TV (2 lignes, K colonnes)
        TL(1, k) = TV(I + 1, 1) 'récupère dans la première ligne la donnée ligne I+1 colonne 1 de TV
        TL(2, k) = TV(I + 1, 2) 'récupère dans la seconde ligne la donnée ligne I+1 colonne 2 de TV
        k = k + 1 'incrémete K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
O.Range("G4").CurrentRegion.ClearContents 'vide d'éventuelles anciennes données
O.Range("G4").Resize(1, 2).Value = Application.Index(TV, 1) 'renvoie les en-têtes
O.Range("G5").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé
End Sub

Bonjour ThauThème,

En voyant ce code, je me dis que je suis encore à des années-lumières de pouvoir créer des programmes comme ça.

En plus le petit "O.Range", je ne sais pas si c'est fait exprès, mais c'est très subtil.

Maintenant pour ce qui est des résultats, il me sort une erreur "Incompatibilité de type" pour la ligne 15. Evidemment comme je ne comprends pas tellement tout le code, je ne vois pas comment pallier à l'erreur. ^^

Est-ce que tu aurais une idée ?

Merci d'avance.

Re,

O.Range n'est pas une subtilité mais une coïncidence... J'aurais pu utiliser F comme variable pour Feuille et obtenir F.Range et là ça aurait été carrément décoiffant...

Je n'ai eu aucun problème avec le code, aucune erreur.

La ligne 15 c'est :

ReDim Preserve TL(1 To 2, 1 To k) 'redimensionne le tableau de lignes TV (2 lignes, K colonnes)

je ne vois pas pourquoi elle planterait alors que la ligne 9 :

ReDim Preserve TL(1 To 2, 1 To 1) 'redimensionne le tableau de lignes TV (2 lignes, 1 colonne)

elle, fonctionne...

Ci-dessous le code un peu plus bétonnée (si tableau vide, etc.) mais tu devrais rencontrer le même problème (que moi je ne rencontre pas !...)

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("C4").CurrentRegion 'définit le tableau des valeurs TV
If UBound(TV, 1) <= 1 Then Exit Sub 'si le tableau est vide
ReDim Preserve TL(1 To 2, 1 To 1) 'redimensionne le tableau de lignes TV (2 lignes, 1 colonne)
TL(1, 1) = TV(2, 1) 'récupère dans la première ligne la donnée ligne 2 colonne 1 de TV
TL(2, 1) = TV(2, 2) 'récupère dans la seconde ligne la donnée ligne 2 colonne 2 de TV
K = 2 'initialise la variable K
For I = 2 To UBound(TV, 1) - 1 'boucle sur toutes les lignes I du tableau des valeurs TV (de la seconde à l'avant dernière)
    If CInt(TV(I, 2)) <> CInt(TV(I + 1, 2)) Then 'condition : si la donnée ligne I, colonne 2 de TV est différente de la donnée ligne I+1 colonne de de TV (les deux converties en entier)
        ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau de lignes TV (2 lignes, K colonnes)
        TL(1, K) = TV(I + 1, 1) 'récupère dans la première ligne la donnée ligne I+1 colonne 1 de TV
        TL(2, K) = TV(I + 1, 2) 'récupère dans la seconde ligne la donnée ligne I+1 colonne 2 de TV
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
O.Range("G4").CurrentRegion.ClearContents 'vide d'éventuelles anciennes données
O.Range("G4").Resize(1, 2).Value = Application.Index(TV, 1) 'renvoie les en-têtes
If K > 2 Then O.Range("G5").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé si K est supérieure à 2
End Sub

Re,

J'aurais préféré un A plutôt, ce serait génial de trouver une solution qui m'A.Range (sic)...BREF !

J'ai aussi testé un petit :

j = 5
i = 6

Do While O.Cells(i, "H") <> ""

    i = i + 1
    j = j + 1

    If Cells(i, "I").Value = Cells(j, "I").Value Then

        O.Cells(i, "H").Value = O.Cells(j, "H").Value

    End If

Loop

Le nom des cellules changent par rapport à ton exemple, mais le principe est le même.

Et même là avec mon petit code il ne parvient pas à détecter que deux valeurs sont égales. Je me pose juste une question : ces différentes valeurs (60, 30, 0), découlent de fonctions Excel qui prennent le minimum des valeurs de plusieurs colonnes. Alors en principe avec le code VBA on n'obtient que les valeurs pures sans fonctions ni rien dans les cellules, néanmoins ça coïncide quand même avec les valeurs de Pk qui apparaissent et créent des doublons. Est-ce que ça peut effectivement influencer sur le code VBA et ses résultats ?

Ca me paraît quand même bizarre que même en ne tenant compte que des valeurs les antécédents de formules subsistent, surtout si le résultat est le même, mais je ne vois pas d'autre explication !

Re,

C'est vrai que je navet (dans ce cas on peut...) pas compris pourquoi mon code ne fonctionnait pas si je ne convertissais pas les données en Entier (CInt) ou en Texte (CStr). J'avais oublié de t'en parler dans mon premier post.

Maintenant pour ce qui est la méthode, bien que le code semble assez similaire, l'accès à une variable tableau de type variant est beaucoup, mais beaucoup plus rapide que l'accès direct aux cellules... il est clair que dans ton exemple si on mesure le temps mis par les deux macros, il ne doit pas y avoir beaucoup de différence, mais pour de très gros tableaux, c'est le jour et la nuit...

Bonjour,

Oui je comprends ce que tu veux dire, et c'est peut-être pour ça que mon fichier global fait plus de 38Mo. J'ai des gros tableaux. Heureusement que j'utilise du VBA, j'ose imaginer la taille sans quoi ! ^^

Bref, merci pour tes conseils ! Mais je dois avouer que j'ai contourné le problème pour obtenir ce que je voulais : j'ai fait en sorte que dans le tableau où il va chercher les valeurs, dès que la valeur est égale à la valeur maximale (soit le 60 ici), il n'affiche rien. Du coup bah les doublons s'en sont allés.

Merci quand même !

Rechercher des sujets similaires à "supprimer doublons consecutifs"