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

Résolu
Erdnax Messages postés 2273 Date d'inscription   Statut Contributeur Dernière intervention   -  
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 @+

13 réponses

Réponse 1 / 13
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   435
 
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
Réponse 2 / 13
Erdnax Messages postés 2273 Date d'inscription   Statut Contributeur Dernière intervention   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
Réponse 3 / 13
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   435
 
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
Réponse 4 / 13
Erdnax Messages postés 2273 Date d'inscription   Statut Contributeur Dernière intervention   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

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

Posez votre question
Réponse 5 / 13
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   435
 
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
Réponse 6 / 13
Erdnax Messages postés 2273 Date d'inscription   Statut Contributeur Dernière intervention   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
Réponse 7 / 13
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   435
 
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
Réponse 8 / 13
Erdnax Messages postés 2273 Date d'inscription   Statut Contributeur Dernière intervention   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
Réponse 9 / 13
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   435
 
Presque ;-).....
Peux-tu stp coller le code,comme ça je comprendrai mieux où tu veux en venir... ?

A+
0
Réponse 10 / 13
Erdnax Messages postés 2273 Date d'inscription   Statut Contributeur Dernière intervention   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
Réponse 11 / 13
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   435
 
Sinon, envoie ton classeur par mail : tomsound2222@yahoo.fr

A+
0
Erdnax Messages postés 2273 Date d'inscription   Statut Contributeur Dernière intervention   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
Réponse 12 / 13
Erdnax Messages postés 2273 Date d'inscription   Statut Contributeur Dernière intervention   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
Réponse 13 / 13
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   435
 
De rien :-)

A+
0

Discussions similaires

Devinette
Boura10000 -
Utilisateur anonyme -

2 réponses
paiment 4x nickel sur top achat
Lohan -
Afrikarnak -

1 réponse
Changer l'orientation d'une seule diapo
lolo6780 -
m@rina -

1 réponse
Que peut faire 3fois/j un homme, mais qu'1fois/j une femme
Soter -
Raymond PENTIER -

1 réponse