Eliminer répitition valeur dans cellule VBA

pickwé -
Normad Messages postés 112 Date d'inscription Statut Membre Dernière intervention - 20 mai 2013 à 13:03

Bonjour,

Je suis débutant en VBA et j'ai un problème qui m'enquiquine sérieusement parce qu'il m'empêche d'avancer dans mon travail ... Je vous serais très reconnaissant si vous pouviez me venir en aide ...
Voilà mon problème :
J'ai deux colonnes "A" et "B" dont les infos sont liées.
Dans les cellules de "A" j'ai répétition des infos séparées par un ";" du style maison;maison;maison etc le nombre de répétition est indéterminée.
Dans la colonne "B" j'ai aussi répitions d'infos mais celles ci peuvent être différentes du style
robinet;robinet;évier;garage;garage etc le nombre de répétition est aussi indéterminée.
Ce que je souhaiterais c'est d'avoir création de lignes qui gardent les infos dans les autres colonnes ("C","D" etc) qui elles sont uniques mais cette fois avec dans "A" la valeur maison et une ligne pour chaque valeur différente dans "B". Dans cet exemple ça ferait:

Colonne A Colonne B
maison robinet
maison évier
maison garage

Je vous remercie d'avance car le problème me paraît compliqué.

A bientôt

Anthony

Afficher la suite

A voir également:

Eliminer répitition valeur dans cellule VBA
Excel compter cellule couleur sans vba - Guide
Excel cellule couleur si condition texte - Guide
Aller à la ligne dans une cellule excel - Guide
Proteger cellule excel - Guide
Excel si cellule contient partie texte ✓ - Forum Excel

1 réponse

Réponse 1 / 1

Normad Messages postés 112 Date d'inscription Statut Membre Dernière intervention 40

Oui, ce n'est pas super-simple (plus de 2 heures...)
Avec les données dans les colonnes A et B de Feuil1 :

Sub Traitement()
    Dim TableauB() As String, ValeurA As String, I As Integer, Y As Integer, Z As Integer, Ligne As Long
    Ligne = 1
    For I = 1 To Sheets("Feuil1").Range("A1").End(xlDown).Row
        ValeurA = TableauValeurs(Sheets("Feuil1").Range("A" & I).Value, True)
        TableauB = TableauValeurs(Sheets("Feuil1").Range("B" & I).Value)
        Z = 1
        For Y = Ligne To UBound(TableauB) + Ligne - 1
            Sheets("Feuil1").Range("C" & Y).Value = ValeurA
            Sheets("Feuil1").Range("D" & Y).Value = TableauB(Z)
            Z = Z + 1
        Next Y
        Ligne = Y
    Next I
End Sub

Function TableauValeurs(strTest As String, Optional A As Boolean)
    Dim Y As Integer, I As Integer, Decomp() As String, Test As String
    Test = strTest
    Y = InStr(1, Test, ";")
    While Y > 0
        I = I + 1
        ReDim Preserve Decomp(I)
        Decomp(I) = Left(Test, Y - 1)
        If A Then GoTo Val1
        Test = Mid(Test, Y + 1)
        Y = InStr(1, Test, ";")
    Wend
    I = I + 1
    ReDim Preserve Decomp(I)
    Decomp(I) = Mid(Test, Y + 1)
    
    TableauValeurs = SupprDoublons(Decomp)
    Exit Function
Val1:
    TableauValeurs = Decomp(1)
End Function

Function SupprDoublons(Tableau)
    Dim I As Integer, Y As Integer, NewTab() As String, Cpte As Integer, Ajoute As Boolean
    If Not IsArray(Tableau) Then
        SupprDoublons = Tableau
        Exit Function
    End If
    
    For I = 1 To UBound(Tableau)
        For Y = 1 To IIf(TailleTab(NewTab) = 0, 1, Cpte)
            If TailleTab(NewTab) = 0 Then
                Ajoute = True
            Else
                If Tableau(I) <> NewTab(Y) Then
                    Ajoute = True
                Else
                    Ajoute = False
                End If
            End If
        Next Y
        If Ajoute Then
            Cpte = Cpte + 1
            ReDim Preserve NewTab(Cpte)
            NewTab(Cpte) = Tableau(I)
        End If
    Next I
    SupprDoublons = NewTab
End Function

Private Function TailleTab(Tableau() As String) As Integer
    On Error GoTo vide
    TailleTab = UBound(Tableau)
    Exit Function
vide:
    TailleTab = 0
End Function

Discussions similaires

Excel VBA : Récupérer la valeur d'une cellule

Cette valeur ne correspond pas aux restrictions

additionner nombres dans cellules avec texte

restriction de valeur sur Excel

Problème de restrictions

Votre réponse

Discussions similaires