test vba excel soustraction cellule

Version imprimable

07/04/2009, 16h14
marie33000

test vba excel soustraction cellule

Bonjour tout le monde, j'ai un petit soucis pour écrire un code :(.

Je souhaite pouvoir vérifier une opération de soustraction. Je m'explique:
- je dispose de donnée dans une colonne excel (colonne A)
- cette colonne est rempli chiffres (type double)
- je souhaite vérifier la soustraction (b-a= 1.5 par exemple)
- mettre dans la colonne E par exemple les valeurs correspondantes de b et a.

Voici un exemple pour que cela soit plus clair :? :

Colonne A
1
2
3.5
5
8.5
10

Dans la colonne E il y aura
2
3.5
8.5
10

Car:
3.5-2= 1.5
b-a = 1.5
donc on les met dans la colonne E

De même : 10-8.5= 1.5
On met 10 et 8.5 dans la colonne E

Voilà voilà, si quelqu'un à une idée qui pourrait m'aider je suis preneuse.

Merci par avance ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
Dim i As Integer
Dim j As Integer
 
For i = 1 To Range("A65536").End(xlUp).Row
    For j = i+1 To Range("A65536").End(xlUp).Row
        If Abs(Cells(i, 1) - Cells(j, 1)) = 1.5 Then
            Cells(i, 5) = Cells(i, 1)
            Cells(j, 5) = Cells(i, 1)
        End If
    Next j
Next i

données initiales en colonne 1
résultats en colonne 5

Une chtite erreur de ma part quand tu m'avais posé la question, cette version devrais marcher

07/04/2009, 16h28
marie33000

Bonjour vous ;)

Je viens d'essayer ton code mais ca me met une erreur à la ligne :

Code:

If Abs(Cells(i, 1) - Cells(j, 1)) = 1.5 Then

--> "incompatibilité de type"

Je ne comprend pourquoi ça me met ça :?

Parce qu'il ne reconnait pas le contenue des cellules (pas des nombre)
Regarde le i qui corespond a ton erreur et regare la valeur de la ligne qui correspond

Regarde si ce code te fait un message
Code:

1 2 3 4 5 6 Dim i As Integer For i = 1 To Range("A65536").End(xlUp).Row If Not (IsNumeric(Cells(i, 1))) Then MsgBox ("Lav aleur de la ligne " & i & " n'est pas numérique") End If Next i
Si oui sur une ligne avec des nombre remplace les . par des , ou inversement

(ou modifie dans les option ton identificateur de décimale, je ne sais pas ou sur 2007)

07/04/2009, 16h47
marie33000

Oui en effet, c'était parce qu'il fallait commencer le i à '2' et non pas à '1'... :oops:

Par contre il n'y a plus d'erreur à présent mais ça ne m'affiche pas les résultats dans une autre colonne.
Lorsque je clique sur le bouton il a l'air de rechercher les valeurs car le bouton reste appuyé puis dès qu'il a fini il n'y a rien... :bug:

J'ai testé avec une autre valeur et ça a l'air de marcher un peu quand même.
Voici mon test (avec b-a=1)

Colonne A

2
3
8
9
11
15
23
24

Réponse colonne E

2
2
8
8

23
23

Il ne récupère en fait que la valeur du 'a' et non du 'b'

le deuxième code ne fait quelque chose que si il y a une valeur non numérique.

sinon essaye celui la (que l'on sache si ca marche)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Dim i As Integer
Dim j As Integer
Dim test As Boolean
 
test = True
For i = 1 To Range("A65536").End(xlUp).Row
    For j = i+1 To Range("A65536").End(xlUp).Row
        If Abs(Cells(i, 1) - Cells(j, 1)) = 1.5 Then
            Cells(i, 5) = Cells(i, 1)
            Cells(j, 5) = Cells(j, 1)  'je m'étais planté ici désolé
            test = False
        End If
    Next j
Next i
If test Then
    MsgBox "Aucune valeur ne corespondant au critère n'a étét trouvé"
else 
    MsgBox "Des valeurs ont bien été trouvée"  'facultatif celui là
End If

edit je viens de voir ton messag le code est corigé

07/04/2009, 16h57
marie33000

Alors lorsque je lance ton dernier code, cela me met:

"Aucune valeur ne correspondant au critère n'a été trouvé"

voili voilou
07/04/2009, 17h57
Qwazerty

Salut
A mon avis le probleme est le suivant, le faite de créer la 2eme boucle a partir de la cellule de la 1er fait que seull les valeurs qui suive celle que l'on pointe sont testé.
Ca a pas l'aire claire dis comme ca mais c tres simple

colonneA
17.5
9
16
10.5

la boucle va tester
17.5-9 ; 17.5-16 ; 17.5-10.5
9-16;9-10.5
16-10.5
mais elle ne testera jamais
9-17.5
16-9;16-17.5
10.5-16;10.5-9;10.5-17.5

et donc on manque un couple de valeur ;)

Je pense que le plus simple pour résoudre ton problème est de prendre le premier nombre de lui ajouter 1.5 et de chercher dans la liste si ce nombre existe, faire pareil en supprimant 1.5 au nombre cette fois.
Exemple valeur de base 17,5, on va donc chercher a trouver 19 (19-17,5 = 1,5) et 16 (17.5-16=1,5).
A toi de jouer, essais de créer le code et reviens nous en cas de probleme.

A++
Qwaz
A++
Qwaz
07/04/2009, 18h15
Krovax

17.5-9 et 9-17.5 donne le même résultat puisque je' teste la valeur absolue. Ce qui permet de faire gagner pas mal de temps
07/04/2009, 18h18
Qwazerty

Oupss désolé j'etais passé a coté :p

Par formule aussi ça se fait, par contre il faudrait retraiter le résultat pour virer les lignes vide ou modifier la formule pour utiliser une forme matriciel peut être, mais la j'avoue que la forme matriciel c'est pas ma tasse de thé ^^
tes nombres en colonneA, en B2 la valeur recherché, en colonne C cette formule

Code:

=SI(NON(ET(ESTERREUR(EQUIV(A2+$B$2;A:A;0));ESTERREUR(EQUIV(A2-$B$2;A:A;0))));A2;"")

A++
Qwaz

Re
Une tite modif pour me faire pardonné ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub essai()
Dim test As Boolean
 
test = True
For i = 2 To Range("A65536").End(xlUp).Row
    For j = i + 1 To Range("A65536").End(xlUp).Row
        If Abs(Cells(i, 1) - Cells(j, 1)) = 1.5 Then
            'Cells(i, 5) = Cells(i, 1)
            'Cells(j, 5) = Cells(j, 1)  'je m'étais planté ici désolé
            If Columns("E").Find(Cells(i, 1), LookIn:=xlValues) Is Nothing Then Cells(Rows.Count, "E").End(xlUp).Offset(1, 0) = Cells(i, 1)
            If Columns("E").Find(Cells(j, 1), LookIn:=xlValues) Is Nothing Then Cells(Rows.Count, "E").End(xlUp).Offset(1, 0) = Cells(j, 1)
            test = False
        End If
    Next j
Next i
If test Then
    MsgBox "Aucune valeur ne correspondant au critère n'a été trouvé"
Else
    MsgBox "Des valeurs ont bien été trouvée"  'facultatif celui là
End If
 
End Sub

plus de ligne vide et plus de doublon
A++
Qwaz