boucle avec IF

Version imprimable

19/09/2012, 12h10
jerome.cubi

boucle avec IF
Bonjour j'ai une question de debutant en VBA...je dois faire une boucle avec des IF et je ne sais pas trop comment faire cela.
En gros si la cellule a la donnée de la variable "NomClient" il incrémente d'une cellule et pareil si la cellule est vide. le problème est si il y a plus que deux cellules vides et pareil si le nom client est le même, c'est pour cela que j'aimerais faire une boucle.

Merci 1000x de votre aide
Code:

1 2 3 4 5 6 7 8 If ActiveCell.Value = NomClient Then SourceStart = SourceStart + 1 End If If Len(ActiveCell.Value) = Empty Then SourceStart = SourceStart + 1 End If

Exemple de code qui boucle sur la colonne A de la feuille Feuil1 à partir de la ligne Deb jusqu'à la dernière ligne remplie de la colonne A.
Ce code retourne la ligne SourceStart de la première cellule non vide et différente de la valeur de NomClient (ici pour l'exemple est donnée par la constante NomClient: /!\ à adapter à ta variable et à ton fichier)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Test()
Const NomClient As String = "Toto"
Dim Deb As Long, LastLig As Long, i As Long, SourceStart As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row    'dernière cellule remplie de la colonne A
    Deb = 3                                        'on commence la boucle de la ligne 3
    For i = Deb To LastLig
        If .Range("A" & i) <> NomClient And .Range("A" & i) <> "" Then
            SourceStart = i
            Exit For
        End If
    Next i
End With
MsgBox SourceStart
End Sub

Bonjour mercatog,

Je te remercie pour ta reponse mais je crois que je ne me suis pas très bien exprimé dans ma question et je m'excuse.

je copie et colle des cellules avec des noms client dans une autre feuille mais pas plus d'une fois car il pourrait avoir plusieurs fois les noms clients mais aussi des blancs.

Je te remercie de ton aide.
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 Sub CopyClient() DestStart = 1 SourceStart = 1 FlagGen = False Dim NomClient As String Sheets("Sheet1").Select ' While FlagGen = False Range("a" & SourceStart).Select If Len(ActiveCell.Value) = Empty Then SourceStart = SourceStart + 1 ElseIf (ActiveCell.Value) = NomClient Then SourceStart = SourceStart + 1 End If Range("A" & SourceStart).Select Selection.Copy Sheets("Sheet2").Select Range("B" & DestStart).Select ActiveSheet.Paste Sheets("Sheet1").Select Range("A" & SourceStart).Select NomClient = ActiveCell.Value SourceStart = SourceStart + 1 DestStart = DestStart + 1 Wend End Sub
Voici le code complet (avant modification)

Si j'ai bien compris, tu veux copier les clients sans doublons vers Sheet2

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Test()
Dim LastLig As Long, i As Long
 
Application.ScreenUpdating = False
With Worksheets("Sheet1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row    'dernière cellule remplie de la colonne A
    'On boucle de A1 à Axx de Sheet1
    For i = 1 To LastLig
        'Si la cellule Ai n'est pas vide
        If .Range("A" & i) <> "" Then
            'Si Ai n'est pas encore copiée dans Sheet2, On copie Ai:Bi dans la première cellule vide de la colonne A de Sheet2
            If Application.CountIf(Worksheets("Sheet2").Range("A:A"), .Range("A" & i)) = 0 Then .Range("A" & i & ":B" & i).Copy Worksheets("Sheet2").Cells(.Rows.Count, "A").End(xlUp)(2)
        End If
    Next i
End With
End Sub

Sinon, quelle est ta version d'Excel (Car on peut utiliser RemoveDuplicate à partir d'Excel 2007 et sans boucle)

19/09/2012, 15h55
jerome.cubi

C'est exact je veux copier les clients sans doublons de la sheet1 à la 2 dans doublons j'utilise la version 2010, je vais essayer le RemoveDuplicate.

Merci beaucoup

On copie l'ensemble des données vers Sheet2 et on appel Supprimer les doublons (RemoveDuplicates)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Test()
Dim LastLig As Long
 
Application.ScreenUpdating = False
With Worksheets("Sheet1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row    'dernière cellule remplie de la colonne A
    'on copie les données vers Sheet2
    .Range("A1:B" & LastLig).Copy Worksheets("Sheet2").Range("A1")
End With
'On supprime les doublons
Worksheets("Sheet2").Range("A1:B" & LastLig).RemoveDuplicates Columns:=1, Header:=xlNo    'xlYes si tu as en ligne 1 des entêtes de colonnes
End Sub