VBA-E Trouver une cellule

Version imprimable

12/11/2007, 12h53
NiKoS29

VBA-E Trouver une cellule

Bonjour à tous,

J'ai un fichier dans le lequel je viens coller une colonne de valeurs (nombre à 5 chiffres). (collage en A2)
Afin de n'avoir aucun doublon, je fais un tri par ordre croissant. Puis en B3, je tape la formule = Si(A3=A2;"1";"") que j'étends jusqu'à la dernière cellule non vide en A. Puis je refais un tri sur la colonne B pour afficher les cellules vides en premier (cellules vides = cellules sans doublon).

Mon problème arrive maintenant. Je voudrais supprimer toutes les valeurs avec des "1" car elles ne me servent à rien. A partir de B2, je souhaiterais aller à la 1ère cellule non vide ou la 1ère cellule avec un "1".
Mais je n'arrive pas à le faire. J'ai essayé avec un Find mais marche pas.
Quelqu'un peut me filer un coup de main svp ?

Merci d'avance. :lol:
12/11/2007, 14h50
eagleleader

Salut,

Insère une partie de ton code pour que l'on voit ce que tu as déjà fait ...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Sub Suppr_doublons()
'
' Suppr_doublons Macro
' Macro enregistrée le 08/11/2007
'
 
'Copie de la colonne article
Sheets("Extract. Article").Select
Range([D2], [D2].End(xlDown)).Select
Selection.Copy
Sheets("Feuil5").Select
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
 
'Tri de la colonne article
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
'Formule pour identifier les doublons
Range("B2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],""1"","""")"
Range("B2").Select
Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
 
'Copier/coller spécial valeurs des deux colonnes A et B
Range([A2], [A2].End(xlDown).Offset(0, 1)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
'Trouver la 1ère valeur "1"
Range("B2").End(xlDown).Activate
Range(ActiveCell.Offset(-1, 0), ActiveCell.End(xlDown)).Select
Selection.Delete
 
End Sub

Lorsque je fais Range("B2").End(xlDown).Activate, cela va activer directement la dernière cellule de la colonne B et non la 1ère cellule qui a une valeur à "1". Cela est dû à la formule que j'écris dans la colonne B au début.

bonjour
je propose ce code qui semble marcher sans faire aucun tri prealable

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub suprdouble()
' ************************* declaration des variables ******************************
' nombre de lignes de la feuille
Dim nblig As Integer
' valeur en cours de test
Dim valtest As Long
' flag de fin de derniere ligne
Dim flag As Boolean
' variables de boucle
Dim i As Integer
Dim j As Integer
' ************************* compte le nombre de ligne ******************************
' initialise nombre de ligne a zero et flag a true
nblig = 0
flag = True
' jusqu'a ce que flag soit false ajoute 1 a nombre de ligne
Do Until flag = False
    nblig = nblig + 1
    ' si la cellule 1 de la ligne en cours est vide alors flag a false
    If Worksheets("Extract. Article").Cells(nblig, 1).Value = "" Then flag = False
Loop
' enleve la derniere ligne celle qui est vide du compteur de lignes
nblig = nblig - 1
 
' ************************* coparaison des valeurs de la col A  ******************************
' pour les nblig lignes de la feuille
For i = 2 To nblig
    'recupere dans valtest la valeur a comparer avec les lignes suivantes
    valtest = Worksheets("Extract. Article").Cells(i, 1)
    ' pour les nblig lignes de la feuille
    For j = i + 1 To nblig
        'compare la valeur de la cellule en cours avec valtest
        ' et si = on efface le doublon et le nombre de ligne est reduit de 1
        If Worksheets("Extract. Article").Cells(j, 1).Value = valtest Then
            Rows(j & ":" & j).Select
            Selection.Delete Shift:=xlUp
            nblig = nblig - 1
        End If
    Next j
Next i
End Sub

a plus
gerard

12/11/2007, 15h32
jpenja
Pour trouver la première cellule de ta colonne b contenant un 1 tu peux utiliser ceci
Code:

1 2 3 4 5 6 7 Dim x As Integer x = 2 While Feuil?.Range("b" & x).Value <> 1 x = x + 1 Wend Feuil?.Range("b" & x).Activate
? étant le numéro de ta feuille
12/11/2007, 16h44
NiKoS29

J'ai testé le code de jpenja qui me semblait plus simple et ça marche.
Merci à vous deux pour votre aide.:king: