Discussion :

[juju1988]

Bonjour,

J'ai dans mon fichier excel un tableau, qui va de la ligne 13 à la dernière ligne remplie
de mon tableau récupérée comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Cells(Rows.Count,1).End(xlUp).Row

Je veux parcourir mon tableau, si il comporte deux lignes qui se suivent ayant la même
valeur en colonne A il faut que la règle pour changer la colonne O soit celle ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
        If Range("O" & i).Value = "DEG" Then
                Range("O" & i).Value = "Dégressif 1"
        Else
                Range("O" & i).Value = "Linéaire"
        End If

Si 6 lignes qui se suivent ont la même valeur en colonne A il faut que la règle pour changer
la colonne O soit celle ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
            If Range("O" & i).Value = "DEG" Then
                    Range("O" & i).Value = "Dégr. 1/Lin."
            Else
                    Range("O" & i).Value = "Linéaire"
            End If

Mon but est donc de changer les valeurs de la colonne O en fonction de si il existe deux
lignes consécutives les mêmes ou 6 lignes...

Je n'arrive pas à faire ma macro ... j'ai beau tourner le problème dans tous les sens c'est
bête mais je bloque ! J'ai testé avec un compteur sans compteur ... je trouve pas.

Voici une ébauche de code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub ModifTypeAmort()
Dim DerniereLigne As Long
Dim Compteur As Integer
DerniereLigne = Cells(Rows.Count, 1).End(xlUp).Row
 
For i = 13 To DerniereLigne
        Compteur = 1
        If Range("A" & i).Value = Range("A" & i + 1).Value Or Range("A" & i).Value = Range("A" & i - 1).Value Then
            Compteur = Compteur + 1
        End If
        MsgBox (Compteur)
    If Compteur = 2 Then
        If Range("O" & i).Value = "DEG" Then
                Range("O" & i).Value = "Dégressif 1"
        Else
                Range("O" & i).Value = "Linéaire"
        End If
    Else
        If Compteur = 6 Then
            If Range("O" & i).Value = "DEG" Then
                    Range("O" & i).Value = "Dégr. 1/Lin."
            Else
                    Range("O" & i).Value = "Linéaire"
            End If
        End If
    End If
Next i
End Sub

Merci d'avance pour vos idées.

[juju1988]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub ModifTypeAmort()
Dim DerniereLigne As Long
Dim Compteur As Integer
DerniereLigne = Cells(Rows.Count, 1).End(xlUp).Row
 
For i = 13 To DerniereLigne
    If Range("A" & i).Value = Range("A" & i + 2).Value Or Range("A" & i).Value = Range("A" & i - 2).Value Then
        If Range("O" & i).Value = "DEG" Then
            Range("O" & i).Value = "Dégr.1/Lin."
        Else
            Range("O" & i).Value = "Linéaire"
        End If
    Else
        If Range("O" & i).Value = "DEG" Then
            Range("O" & i).Value = "Dégressif 1"
        Else
            Range("O" & i).Value = "Linéaire"
        End If
    End If
Next i
End Sub

Bon c'est peut être pas très protocolaire mais bon j'ai juste arrêté de me prendre la tête et la technique du + 2 - 2 fonctionne dans ma boucle de vérification ...

Je met mon code peut être que ça servira toujours...

[aliasjadawin]

Il me semble, du coup, qu'avec ta technique "+2/-2" tu obtient un test d'égalité de valeurs sur 5 cellules et non pas 6. Est-ce vraiment ce que tu voulais à la base ?

Pourquoi ne pas essayer:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
For i = 13 To DerniereLigne
If Range("A" & i).Value = Range("A" & i + 1).Value And Range("A" & i).Value <> Range("A" & i + 2).Value Then

par exemple par contre la deuxième condition risque d'être beaucoup plus longue...

[juju1988]

Honnetement je sais plus à force lol !!
J'avais déjà utilisée ta technique mais ça marchait pas pour les derniers d'une liste de 6 par exemple vu que après on passe encore à une autre valeur (en i +2) ...
(Je sais pas si tu me suis...)
En gros si i = 1
si on fait i + 2 ça veut direr i = 3 et si en i = 3 on a la même valeur c'est qu'on a plus de 3 enregistrements

si on a i = 5
si on fait i - 2 on est à i =3 avec la même valeur donc au moins 5 enregistrements les mêmes ...

Donc on a plus de 2 enregistrements ==> cas 6 enregistrements semblables

Sinon cas 2 enregistrements semblables car si i = 1 en i + 2 on ne doit logiquement pas avoir le même enregistrement ...

(J'ai fait de mon mieux pour l'explication là lol)

[Pierre Fauconnier]

Salut.

Si j'ai bien compris l'énoncé, tu dois d'abord tester si six valeurs identiques se suivent avant de tester si deux valeurs identiques se suivent...

Je te propose de tester le code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Amortissement()
  Dim Cellule As Range
 
  Set Cellule = Range("A2")
 
  Do While Not IsEmpty(Cellule) ' On boucle tant qu'il y a des valeurs en A
    ' On teste si six valeurs identiques se suivent en A, grâce à NB.SI en VBA
    If WorksheetFunction.CountIf(Range(Cellule, Cellule(6, 1)), Cellule.Value) = 6 Then
        If Cellule(1, 15).Value = "DEG" Then
          Cellule(1, 15).Value = " Dégr. 1/Lin."
          Else
          Cellule(1, 15).Value = "Linéaire"
        End If
        ' On fait pointer Cellule vers la première cellule du prochain groupe en A, 7 lignes plus bas
        Set Cellule = Cellule(7, 1)
      ' Si pas six valeurs qui se suivent, on teste si deux valeurs se suivent
      ElseIf WorksheetFunction.CountIf(Range(Cellule, Cellule(2, 1)), Cellule.Value) = 2 Then
        If Cellule(1, 15).Value = "DEG" Then
          Cellule(1, 15).Value = " Dégressif"
          Else
          Cellule(1, 15).Value = "Linéaire"
        End If
        ' On fait pointer Cellule vers la première cellule du prochain groupe en A, 3 lignes plus bas
        Set Cellule = Cellule(3, 1)
      Else
        ' Si ni six ni deux valeurs qui se suivent, on fait pointer Cellule vers la ligne suivante en A
        Set Cellule = Cellule(2, 1)
    End If
  Loop
End Sub

[juju1988]

Bonjour,

En fait je dois parcourir mon tableau par exemple :

(colonne A)
5000
5000
6000
6000
6000
6000
6000
6000
3000
3000

Si c'est deux fois la même valeur (comme pour 5000) je fais le traitement cité précédemment si c'est 6 fois la même valeur (comme pour 6000) je fais l'autre traitement cité précédemment...

Est ce que ça colle avec votre code? Je ne pourrais le tester que lundi prochain malheureusement ...

[Pierre Fauconnier]

Je pense que mon code est censé réaliser cela.

A toi de tester et de revenir pour la suite

[aliasjadawin]

C'est vrai que c'est astucieux, je n'avais pas pensé à NB.SI (CountIf en VBA).
En revanche pourquoi doit-on le faire précéder de WorksheetFunction ?
L'emploi de CountIf renverrait-il une erreur ?

[Pierre Fauconnier]

Salut.

Countif n'est pas une fonction de VBA mais une fonction d'Excel qui est mise à disposition de VBA via l'objet Worksheetfunction, qui présente la collection des fonctions intrinsèques d'Excel.

On peut gagner en simplicité de code en les utilisant, pour éviter d'écrire du VBA "non excel" avec boucles, notamment (d'où ma signature... )

[juju1988]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub ModifTypeAmort()
 
Dim Cellule As Range
 
  Set Cellule = Range("A11")
 
  Do While Not IsEmpty(Cellule) ' On boucle tant qu'il y a des valeurs en A
    ' On teste si six valeurs identiques se suivent en A, grâce à NB.SI en VBA
    If WorksheetFunction.CountIf(Range(Cellule, Cellule(6, 1)), Cellule.Value) = 6 Then
        If Cellule(1, 15).Value = "DEG" Then
          Cellule(1, 15).Value = " Dégr. 1/Lin."
          Else
          Cellule(1, 15).Value = "Linéaire"
        End If
        ' On fait pointer Cellule vers la première cellule du prochain groupe en A, 7 lignes plus bas
        Set Cellule = Cellule(7, 1)
      ' Si pas six valeurs qui se suivent, on teste si deux valeurs se suivent
      ElseIf WorksheetFunction.CountIf(Range(Cellule, Cellule(2, 1)), Cellule.Value) = 2 Then
        If Cellule(1, 15).Value = "DEG" Then
          Cellule(1, 15).Value = " Dégressif"
          Else
          Cellule(1, 15).Value = "Linéaire"
        End If
        ' On fait pointer Cellule vers la première cellule du prochain groupe en A, 3 lignes plus bas
        Set Cellule = Cellule(3, 1)
      Else
        ' Si ni six ni deux valeurs qui se suivent, on fait pointer Cellule vers la ligne suivante en A
        Set Cellule = Cellule(2, 1)
    End If
  Loop
 
End Sub

J'ai testé ton code cependant cela ne fonctionne pas ...
Cellule c'est bien la cellule de départ non ?
Cela ne fonctionne que pour la 1° valeur la 3° et l'avant dernière ...