Boucle loop et for ne fonctionnent pas

Version imprimable

14/06/2016, 16h40
victor.dubois

1 pièce(s) jointe(s)

Boucle loop et for ne fonctionnent pas

Bonjour le forum!

Après des jours de recherches sur des forums, guides excel, etc... et de peur de devenir chauve a force de me tirer les cheveux je viens chercher de l'aide ici (toujours en dernier recours!) ........ .... surtout que la solution doit être toute simple mais bon...

Pour faire court mon objectif est le suivant: Copier les lignes d'un tableau qui respectent 3 conditions particulières:
1- la valeur dans la colonne 4 = "FAUX"
2- La date de la colonne 3 doit être antérieur à la date de référence (UserForm1.TextBox1)
3- l'année inclue dans la date de la colonne 2 = UF1.TextBox2

Dans le fichier que j'ai joint, j'ai essayé 2 méthodes (que j'ai bien sûr essayé de combiner dans tout les sens, sans trop de succès) mais seulement la première ligne respectant la condition est copiée, comme si la macro s'arrete une fois la ligne copiée (Je pensais que cette procédure était propre à "Do While")
Pièce jointe 212762

Bon, désolé pour la facilité du problème posé et bien qu'il ai déjà été traité dans le forum, bah je bloque!

Merci d'avance! Tendresse et Chocolats

Victor
14/06/2016, 16h46
Kiouane

Évite de mettre en joint un fichier dans ton premier message. Poste un code pour essayer de mieux cerner ton problème.

Salut Kiouane,

Voici les lignes de codes (j'ai joint le fichier car il se base sur des variables que l'on renseigne via un UserForm, au moins c'est plus clair d'avoir la vision d'ensemble. Et pas de soucis, c'est un document Excel qui reprend que la partie qui bloque et non pas l'ensemble des macro du fichier source!!!)

Méthode essayée 1

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
42
43
Private Sub CommandButton1_Click()
 
Dim dateref As Date 'date a laquelle on se situe virutellement - Aujourd'hui par défaut
Dim datecontrat As Date 'date de signature du contrat (qui doit antécédente à date de référence)
Dim yrlookup As Integer 'Année que l'on souhaite analyser dans la suite du protocole(généralement égale ou supérieur d'une à deux années par rapport à la date de référence)
Dim mtlookup As Integer 'Mois que l'on souhaite analyser (à rendre facultatif)
 
Dim DernCol1 As Integer
DernCol1 = Sheets("RES").Range("A1").End(xlToRight).Column
 
Dim DernLig1 As Long
DernLig1 = 1 'première ligne à vérifier
Do While Not IsEmpty(Sheets("RES").Range("A" & DernLig1))
    DernLig1 = DernLig1 + 1
Loop
 
i = 2
j = 2
Do Until i = DernLig1
    If Range("D" & i).Value = "Faux" Then
        dateref = TextBox1.Value
        yrlookup = TextBox2.Value
        datecontrat = Format(DateSerial(Year(Cells(i, 3)), Month(Cells(i, 3)), Day(Cells(i, 3))), "dd/mm/yyyy")
        datereception = Format(DateSerial(Year(Cells(i, 2)), Month(Cells(i, 2)), Day(Cells(i, 2))), "dd/mm/yyyy")
 
        If datecontrat < dateref And Year(datereception) = yrlookup Then
            Sheets("RES").Range(Cells(i, 1), Cells(i, DernCol1)).Select
            Selection.Copy
            Sheets("test").Select
            Range("A" & j).Select
            ActiveSheet.Paste
            i = i + 1
            j = j + 1 '(pour que la ligne où sont collé les infos voulus soit augmenté de 1 à chaque fois que la condition est vérifié)
        Else
            i = i + 1
        End If
    Else
    i = i + 1
    End If
Loop
 
Unload Me
End Sub

Méthode essayée 2:

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
Private Sub CommandButton2_Click()
 
Dim dateref As Date 'date a laquelle on se situe virutellement - Aujourd'hui par défaut
Dim datecontrat As Date 'date de signature du contrat (qui doit antécédente à date de référence)
Dim yrlookup As Integer 'Année que l'on souhaite analyser dans la suite du protocole(généralement égale ou supérieur d'une à deux années par rapport à la date de référence)
Dim mtlookup As Integer 'Mois que l'on souhaite analyser (à rendre facultatif)
 
Dim DernCol1 As Integer
DernCol1 = Sheets("RES").Range("A1").End(xlToRight).Column
 
Dim DernLig1 As Long
DernLig1 = 1 'première ligne à vérifier
Do While Not IsEmpty(Sheets("RES").Range("A" & DernLig1))
    DernLig1 = DernLig1 + 1
Loop
 
 
For i = 2 To DernLig1
    If Range("D" & i).Value = "Faux" Then
        dateref = TextBox1.Value
        yrlookup = TextBox2.Value
        datecontrat = Format(DateSerial(Year(Cells(i, 3)), Month(Cells(i, 3)), Day(Cells(i, 3))), "dd/mm/yyyy")
        datereception = Format(DateSerial(Year(Cells(i, 2)), Month(Cells(i, 2)), Day(Cells(i, 2))), "dd/mm/yyyy")
 
 
        If datecontrat > dateref And Year(datereception) <> yrlookup Then
 
        Else
            Sheets("RES").Range(Cells(i, 1), Cells(i, DernCol1)).Select
            Selection.Copy
            Sheets("test").Select
            Range("A2").Select
            ActiveSheet.Paste
        End If
    Else
    End If
Next
 
Unload Me
 
End Sub

Bonjour,

Voilà une proposition :

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
42
43
 
Private Sub CommandButton1_Click()
 
Dim dateref As Date 'date a laquelle on se situe virutellement - Aujourd'hui par défaut
Dim datecontrat As Date 'date de signature du contrat (qui doit antécédente à date de référence)
Dim yrlookup As Integer 'Année que l'on souhaite analyser dans la suite du protocole(généralement égale ou supérieur d'une à deux années par rapport à la date de référence)
Dim mtlookup As Integer 'Mois que l'on souhaite analyser (à rendre facultatif)
Dim Ligne_recopie As Double, Colonne_recopie As Double
Dim DernLig1 As Long
Dim DernCol1 As Integer
 
TextBox1.Value = "01/01/2014" 'pour tests *** A supprimer
TextBox2.Value = "01/01/2015" 'pour tests *** A supprimer
 
dateref = CDate(TextBox1.Value)
yrlookup = Year(CDate(TextBox2.Value))
DernCol1 = Sheets("RES").Range("A1").End(xlToRight).Column
 
DernLig1 = 1 'première ligne à vérifier
Do While Not IsEmpty(Sheets("RES").Range("A" & DernLig1))
    DernLig1 = DernLig1 + 1
Loop
DernLig1 = DernLig1 - 1
 
Ligne_recopie = 2
For i = 2 To DernLig1
    If Range("D" & i).Value = "Faux" Then
        datecontrat = Format(DateSerial(Year(Cells(i, 3)), Month(Cells(i, 3)), Day(Cells(i, 3))), "dd/mm/yyyy")
        datereception = Format(DateSerial(Year(Cells(i, 2)), Month(Cells(i, 2)), Day(Cells(i, 2))), "dd/mm/yyyy")
 
        If (datecontrat > dateref) And (Year(datereception) = yrlookup) Then
            For Colonne_recopie = 1 To DernCol1
                Sheets("test").Cells(i, Colonne_recopie).Value = Sheets("RES").Cells(Ligne_recopie, Colonne_recopie).Value
            Next Colonne_recopie
            Ligne_recopie = Ligne_recopie + 1
        End If
 
    End If
Next
 
Unload Me
 
End Sub

Dans ton programme, il est certain que si tu reste sur la page "test" après ton "coller" la boucle suivante ne prends pas les bonnes valeurs.

A+

Merci!

Salut OBO29!
En effet, c'est la ligne qu'il me manquait! Du coup j'ai simplement rajouté Worksheets("RES").select après ma procédure (et toujours dans la boucle), ça fonctionne parfaitement bien!
voici le code final qui fonctionne bien :

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
42
43
44
45
46
47
48
49
50
51
Private Sub CommandButton1_Click()
 
Dim dateref As Date 'date a laquelle on se situe virutellement - Aujourd'hui par défaut
Dim datecontrat As Date 'date de signature du contrat (qui doit antécédente à date de référence)
Dim yrlookup As Integer 'Année que l'on souhaite analyser dans la suite du protocole(généralement égale ou supérieur d'une à deux années par rapport à la date de référence)
Dim mtlookup As Integer 'Mois que l'on souhaite analyser (à rendre facultatif)
Dim DernLig1 As Long
Dim DernCol1 As Integer
Dim DernLig2 As Long
Dim DernCol2 As Integer
 
If Not IsEmpty(Worksheets("test").Range("A2")) Then
Worksheets("test").Cells(2, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
End If
 
DernCol1 = Worksheets("RES").Range("A1").End(xlToRight).Column
DernLig1 = 1 'première ligne à vérifier
Do While Not IsEmpty(Worksheets("RES").Range("A" & DernLig1))
    DernLig1 = DernLig1 + 1
Loop
 
dateref = TextBox1.Value
yrlookup = TextBox2.Value
i = 2
J = 2
 
Do Until i = DernLig1
datecontrat = Format(DateSerial(Year(Cells(i, 3)), Month(Cells(i, 3)), Day(Cells(i, 3))), "dd/mm/yyyy")
datereception = Format(DateSerial(Year(Cells(i, 2)), Month(Cells(i, 2)), Day(Cells(i, 2))), "dd/mm/yyyy")
    If (datecontrat < dateref) And (Year(datereception) = yrlookup) And (Worksheets("RES").Range("D" & i) = "Faux") Then
        Worksheets("RES").Range(Cells(i, 1), Cells(i, DernCol1)).Select
        Selection.Copy
        Worksheets("test").Select
        Range("A" & J).Select
        ActiveSheet.Paste
        Worksheets("RES").Select
        i = i + 1
        J = J + 1 '(pour que la ligne où sont collé les infos voulus soit augmenté de 1 à chaque fois que la condition est vérifié)
    Else
        i = i + 1
    End If
Loop
 
Worksheets("test").Select
Unload Me
 
End Sub

Sujet Résolu!! Merci du coup de main :)