[VBA] Ressortir les données une seule fois.

Résolu
Erdnax Messages postés 2279 Statut Contributeur -  
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour à tous.

Alors voilà. J'ai toute une colonne (4670 enregistrements) dans laquelle des numéros sont inscrits. Ce que j'aimerais faire, ce que ma macro VBA parcours cette colonne, et qu'elle copie les valeurs dans une autre colonne, d'une autre feuille, mais sans doublons...

J'ai déjà fait la base de mon code, mais je ne sais vraiment plus par où continuer... 
Sheets("Base").Activate
Range("A2").Select
While ActiveCell.Value <> ""


Wend

Ce qui me pose vraiment problème, ce n'est pas vraiment le copier coller de la valeur, c'est vraiment le fait de devoir éliminer les doublons pour n'inscrire que des valeurs uniques...

Merci à tous et @+

--
Erdnax
--

13 réponses

  1.
    tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    Salut,

    Tu peux faire ça avec un filtre élaboré (extraction sans doublons):

    Range("A1:A4670").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns("G:G"), Unique:=True

    A+
    0
  2. Erdnax Messages postés 2279 Statut Contributeur 497
     
    Salut,

    Merci pour ça ça marche. Vu que t'as l'air de métriser l'outil, j'aurais encore une question.

    Comment on pourrait faire en sorte qu'une fois les données triées elles soient copiées dans une autre feuille, mais avec deux lignes entres chacunes d'elles ?

    J'ai beau chercher un moyen, mais j'ai quand même pas mal de problèmes...

    Merci @+
    0
  3. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    Salut,

    tu peux essayer ça :
    Sub test()
    Dim laligne As Integer
    Dim i As Integer
    laligne = Range("a65536").End(xlUp).Row
    For i = laligne To 2 Step -1
    If Not IsEmpty(Range("a" & i)) Then Rows(i).Select
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Next i
    End Sub
    Cette macro insere 2 lignes si la cellule en A est non vide (à adapter selon ton cas.....
    Doit y avoir moyen de faire mieux mais ça fonctionne......

    A+

    Tom
    0
  4. Erdnax Messages postés 2279 Statut Contributeur 497
     
    Salut, et merci.

    J'ai le code suivant : 
    Sheets("Base").Range("M2:M65000").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("B2:B65000"), Unique:=True

    Est-ce qu'il est possible de le vérifer pour faire en sorte d'insérer les lignes vides au milieu ?

    @+
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    Re,

    adapté à ton cas :
    Sub test()
    Dim laligne As Integer
    Dim i As Integer
    laligne = Range("b65536").End(xlUp).Row
    For i = laligne To 3 Step -1
    If Not IsEmpty(Range("a" & i)) Then Rows(i).Select
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Next i
    End Sub
    Ca doit fonctionner, tiens moi au courant...

    A+
    0
  7. Erdnax Messages postés 2279 Statut Contributeur 497
     
    Re,

    Alors ça marche et ça marche pas. En fait, ça marche dans une feuille, mais pas dans l'autre, et je comprends pas pourquoi. Dans celle où ça marche pas, ça ne me met pas de message d'erreur, mais c'est juste que je n'ai pas le résultat que je veux...

    J'aurais juste un question, est-ce que tu pourrais m'expliquer comment fonctionne le Selection.Insert Shift:=xlDown, et comme ça je pourrais peut-être voir moi même comment je pourrais faire...

    Merci @+
    0
  8. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    Re,

    Extrait de l'aide:
    Méthode Insert telle qu'elle s'applique à l'objet Range.

    Cette méthode insère une cellule ou une plage de cellules dans la feuille de calcul ou la feuille de macro et déplace les autres cellules pour augmenter l'espace disponible.

    expression.Insert(Shift, CopyOrigin)

    expression Obligatoire. Expression qui renvoie un objet Range.

    Shift Argument de type Variant facultatif. Indique dans quel sens les cellules doivent être déplacées. Il peut s'agir de l'une des constantes XlInsertShiftDirection suivantes : xlShiftToRight ou xlShiftDown. Si vous ne spécifiez pas cet argument, Microsoft Excel agit en fonction de la forme de la plage.

    CopyOrigin Argument de type Variant facultatif. Origine de la copie.



    Et voilà...Tu peux préciser ce qui se passe (ou pas) sur l'autre feuille ?

    A+
    0
  9. Erdnax Messages postés 2279 Statut Contributeur 497
     
    Argl,

    alors en fait, ca me met 124 lignes avant de me recoller mes 64 enregistrements uniques, mais je ne sais pas si ça peut venir de ça, mais parce que j'ai déjà fait une macro de mise en forme, mais qui elle ne travail en rien l'espace. J'ai donc essayé de l'insérer dans ma macro de mise en forme, et juste avant tout, comme ça ça met les espaces, et après c'est tout prêt à être traité...

    T'as compris ^^ ?
    0
  10. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    Presque ;-).....
    Peux-tu stp coller le code,comme ça je comprendrai mieux où tu veux en venir... ?

    A+
    0
  11. Erdnax Messages postés 2279 Statut Contributeur 497
     
    Voila alors 

    Sub mise_en_forme()
'ton code
'
Dim laligne As Integer
Dim i As Integer
laligne = Range("b65536").End(xlUp).Row
For i = laligne To 3 Step -1
If Not IsEmpty(Range("a" & i)) Then Rows(i).Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Next i
'
'et la dessous tout mon code de mise en forme
'
Range("B2").Select
While ActiveCell.Value <> ""
    ActiveCell.Offset(0, 0).Range("A1:A2").Merge
    ActiveCell.Offset(0, 0).Range("A1:A2").Select
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
            
    ActiveCell.Offset(0, 1).Select
        With ActiveCell
        .Value = "in"
            With .Borders
                .LineStyle = xlContinuous
            End With
            With .Interior
                .Color = RGB(255, 255, 102)
            End With
        End With
    ActiveCell.Offset(1, 0).Select
        With ActiveCell
        .Value = "out"
            With .Borders
                .LineStyle = xlContinuous
            End With
            With .Interior
                .Color = RGB(255, 255, 102)
            End With
        End With
     ActiveCell.Offset(-1, 1).Range("A1:I2").Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            Selection.Borders(xlInsideVertical).LineStyle = xlNone
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.Offset(0, 9).Range("A1:A2").Select
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
            With Selection.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
            End With
        ActiveCell.FormulaR1C1 = "=SUM(RC[-9]:RC[-1])"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = "=SUM(RC[-9]:RC[-1])"
    ActiveCell.Offset(2, -11).Select
    
Wend

End Sub


    Je sais, c'est un peu "buche" comme code, mais ça marche, et je suis un peu débutant lol... (on peut noter la dernière ligne qui permet d'aller directement au résultat suivant, pour autant qu'il se trouve plus bas, d'ou mon code du début...)

    :D
    0
  12. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    Sinon, envoie ton classeur par mail : tomsound2222@yahoo.fr

    A+
    0
    1. Erdnax Messages postés 2279 Statut Contributeur 497
       
      Désolé, mais ça je peux pas, j'ai des données confidentielles...

      Je sais que c'est un peu compliqué, mais si ça marche pas, ben j'essayerai de trouver autre chose.

      @+
      0
  13. Erdnax Messages postés 2279 Statut Contributeur 497
     
    YAHOOOOOOOOOOO

    C'est bon, j'ai modifié mon code avec Selection.Insert Shift:=xlDown, j'en ai mis un au début, et j'ai juste une ligne au lieu de deux, mais le résultat est même encore mieux... c'était donc tout simple !!!

    Merci encore et @+
    0
  14. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    De rien :-)

    A+
    0

Discussions similaires

Copier coller impossible
coulondou -
jeanmarc -

43 réponses
Vous avez essayé de vous connecter trop de fo
SGOUGOU -
Dakarth -

33 réponses
Devinette
Boura10000 -
Utilisateur anonyme -

2 réponses
Imprimer 2 fois la même page (PDF) sur la même feuille
®omain -
pop -

21 réponses
Savoir si quelqu'un a bloqué mon numéro
galacticspastic -
jordane45 -

7 réponses