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

Résolu/Fermé

Erdnax Messages postés 2273 Date d'inscription mercredi 1 octobre 2003 Statut Contributeur Dernière intervention 1 octobre 2007 - 10 mars 2005 à 16:04
tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 - 21 mars 2005 à 17:34

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 @+

A voir également:

[VBA] Ressortir les données une seule fois.
Effacer les données de navigation - Guide
Comment imprimer un tableau excel sur une seule page - Guide
Comment sauvegarder toutes les données de mon téléphone - Guide
Signe fois clavier iphone ✓ - Forum Word
Signe fois ✓ - Forum Windows

13 réponses

Réponse 1 / 13

tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 435
10 mars 2005 à 17:40

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+

Réponse 2 / 13

Erdnax Messages postés 2273 Date d'inscription mercredi 1 octobre 2003 Statut Contributeur Dernière intervention 1 octobre 2007 497
21 mars 2005 à 11:51

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 @+

Réponse 3 / 13

tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 435
21 mars 2005 à 14:17

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

Réponse 4 / 13

Erdnax Messages postés 2273 Date d'inscription mercredi 1 octobre 2003 Statut Contributeur Dernière intervention 1 octobre 2007 497
21 mars 2005 à 15:06

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 ?

@+

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 jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 435
21 mars 2005 à 15:20

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+

Réponse 6 / 13

Erdnax Messages postés 2273 Date d'inscription mercredi 1 octobre 2003 Statut Contributeur Dernière intervention 1 octobre 2007 497
21 mars 2005 à 15:59

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 @+

Réponse 7 / 13

tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 435
21 mars 2005 à 16:05

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+

Réponse 8 / 13

Erdnax Messages postés 2273 Date d'inscription mercredi 1 octobre 2003 Statut Contributeur Dernière intervention 1 octobre 2007 497
21 mars 2005 à 16:14

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 ^^ ?

Réponse 9 / 13

tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 435
21 mars 2005 à 16:17

Presque ;-).....
Peux-tu stp coller le code,comme ça je comprendrai mieux où tu veux en venir... ?

A+

Réponse 10 / 13

Erdnax Messages postés 2273 Date d'inscription mercredi 1 octobre 2003 Statut Contributeur Dernière intervention 1 octobre 2007 497
21 mars 2005 à 16:21

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

Réponse 11 / 13

tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 435
21 mars 2005 à 16:21

Sinon, envoie ton classeur par mail : tomsound2222@yahoo.fr

A+

Erdnax Messages postés 2273 Date d'inscription mercredi 1 octobre 2003 Statut Contributeur Dernière intervention 1 octobre 2007 497
21 mars 2005 à 16:25

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.

@+

Réponse 12 / 13

Erdnax Messages postés 2273 Date d'inscription mercredi 1 octobre 2003 Statut Contributeur Dernière intervention 1 octobre 2007 497
21 mars 2005 à 16:51

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 @+

Réponse 13 / 13

tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 435
21 mars 2005 à 17:34

De rien :-)

A+

Discussions similaires

Que peut faire 3fois/j un homme, mais qu'1fois/j une femme

paiment 4x nickel sur top achat

Devinette

Alerte de siréne de mairie

VBA : Range avec références variables..

Discussions similaires

Newsletters