Calcul de dates incorrect

Version imprimable

Voir 40 message(s) de cette discussion en une page

Re
Voila la dernière fournée

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
Sub test4()
Dim CelCol As Range, C As Range
 
For Each CelCol In Sheets(1).Range("B2:B23") 'on scann la colonne deja
    If CelCol.Value <> "" And CelCol.Value2 > 0 Then
        'On coche les case qui doivent l'etre
        'With Sheets(1).Range(Sheets(1).Cells(CelCol.Row, "C"), Sheets(1).Range("B1").End(xlToRight).Offset(CelCol.Row - 1, -((Sheets(1).Range("B1").End(xlToRight).Column - 2) - CInt(CelCol.Value2))))
        If CelCol.Value2 > Sheets(1).Range("B1").End(xlToRight).Column - 2 Then
            'La somme depasse le nombre de jours
            'On met la case en couleur
            CelCol.Interior.ColorIndex = 4
        Else
            'On remet la couleur neutre par defaut
            CelCol.Interior.ColorIndex = xlNone
            With Sheets(1).Range(Sheets(1).Cells(CelCol.Row, "C"), Sheets(1).Cells(CelCol.Row, 2 + CelCol.Value2))
                .Borders(xlDiagonalDown).LineStyle = xlContinuous
                .Borders(xlDiagonalDown).Weight = xlThin
                .Borders(xlDiagonalUp).LineStyle = xlContinuous
                .Borders(xlDiagonalUp).Weight = xlThin
            End With
 
            'On decoche celle qui doivent l'etre
            With Sheets(1).Range(Sheets(1).Cells(CelCol.Row, 3 + CInt(CelCol.Value2)), Sheets(1).Range("B1").End(xlToRight).Offset(CelCol.Row - 1, 0))
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
            End With
        End If
    End If
Next
End Sub

Avec ça même si tu change les valeurs a la baisse, ça décoche les cases qui ne doivent pas être cochées.

J'ai également simplifié grandement mon 1er With, je laisse quand même tout ça dans mon 1er post ça te permet de te familiariser avec les possibilités d'excel (et y'en a bien d'autre, que je connais ou pas d'ailleurs :D) A force d'avoir le nez dedans j'ai fini par ne pas utiliser la voie la plus rapide et la plus simple ;) mais je pense (quelle prétention :)) que c'est chose faite

Pour la Function que tu voudrais faire, la par contre je vois pas trop l'utilité, une function est une sub qui te renvoie une valeur (ou un objet), que voudrais tu renvoyer ?

A++
Qwaz

23/02/2008, 11h02
SKY33

En fait, dans la version actuelle du programme, si par exemple qqn paie 8, il y aura 8 croix.

Et si cette même personne paie 4 quelques jours plus tard, je remplace manuellement 8 par 12 et comme 12 > 10, je souhaiterais que :

- 10 croix apparaissent dans le 1er onglet (avec toujours un fond de couleur appliqué sur la cellule en B pour mettre en évidence que plus de 10 paiements ont été effectués) MAIS QU'EN PLUS, toutes les croix supérieures à 10 soient inscrites à la même position (même référence) dans un autre onglet.

Pour l'avantage de la fonction, je pense qu'étant donné que tous les joueurs ne paient pas en même temps, on verra plus clairement les changements, ligne par ligne, si les modifications avaient lieu "en cours de frappe".

Ex. : je remplace 8 par 9 en B2 et en conséquence, seuls le calcul de la ligne 2 est refait et donc une croix est ajoutée.

Avec ça, je devrais obtenir une version évitant toutes les incohérences.

Merci de ton aide !!! :king::king::king:

SAlut
Bon je te fais ca mais maintenant pour le reste tu propose du code et on voit ce qui va pas, par ce que le je suis en train de faire le boulot a ta place et c'est pas le but de se forum ;)

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
Sub test5(ByVal Target As Range)
Dim SomLimit As Integer
 
If Target.Value <> "" Then
    'On coche les case qui doivent l'etre
    'On prend en compte la somme versé
    SomLimit = Target.Value2
    If SomLimit > Sheets(1).Range("B1").End(xlToRight).Column - 2 Then
        'La somme depasse le nombre de jours
        SomLimit = Sheets(1).Range("B1").End(xlToRight).Column - 2
        'On met la case en couleur
        Target.Interior.ColorIndex = 4
    Else
        'On remet la couleur neutre par defaut si la somme est inferieur ou egale a la somme maxi
        Target.Interior.ColorIndex = xlNone
    End If
 
    If Target.Value2 <> 0 Then 'Pas besoin de mettre des croix, puisque 0 euro
        With Sheets(1).Range(Sheets(1).Cells(Target.Row, "C"), Sheets(1).Cells(Target.Row, 2 + SomLimit))
            .Borders(xlDiagonalDown).LineStyle = xlContinuous
            .Borders(xlDiagonalDown).Weight = xlThin
            .Borders(xlDiagonalUp).LineStyle = xlContinuous
            .Borders(xlDiagonalUp).Weight = xlThin
        End With
    End If
 
    If Target.Interior.ColorIndex <> 4 Then 'Pas besoin d'en enlever, puisque somme maxi
        'On decoche celle qui doivent l'etre
        With Sheets(1).Range(Sheets(1).Cells(Target.Row, 3 + CInt(SomLimit)), Sheets(1).Range("B1").End(xlToRight).Offset(Target.Row - 1, 0))
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
        End With
    End If
End If
End Sub

Et ceci dans ThisWorkSheet

Code:

1
2
3
4
5
6
7
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Column = 2 And Target.Offset(0, -1).Value <> "" Then 'si la case modifié se trouve en colonne B et dans la plage des joueurs (case joueur non vide)
    Module1.test5 Target
End If
 
End Sub

A++
Bon courrage
Qwaz

23/02/2008, 12h16
SKY33

OK Super, un tout grand merci.

Je vais regarder en détails pcq pour l'instant, il me retourne "argument non facultatif".

Je vais aussi travailler sur 2 dernières choses :

1.] remplacer la bordure intérieure par des "X" (c'est idiot de ma part d'avoir compliqué le code à ce point)

2.] demander au programme, de colorer le nom du joueur en rouge si le dernier paiement effectué est inférieur à la date du jour : aujourdhui()

Encore merci pour tout !!

Je te tiens au courant des mes péripéties :mrgreen:
23/02/2008, 13h28
SKY33

Toujours cette réponse "Argument facultatif"..

Je ne vois pas le lien vers le nouvel onglet.

C'est comme s'il appelait une Sub non définie ...
23/02/2008, 13h56
Qwazerty

SAlut
Bizard ça marche très bien chez moi, le mieux serait de faire du pas à pas pour voir quelle ligne pose problème.
Tu click sur la 1er ligne de code de ThisWorkSheet.Change et tu appuis sur F9, ça va te mettre la ligne en rouge.
Ensuite tu va modifier une valeur dans ton tableau, normalement si le code est bien placé, VBA va venir au 1er plan et une flèche va pointé sur la ligne rouge, tu appuis ensuite sur F8 pour avancer pas a pas dans ton code et voir ou ça plante, quand tu as la ligne ou ça plante post ici ;)
++
23/02/2008, 14h34
SKY33

Pardonne-moi d'être lent à la détente, mais tu posterais ton fichier, pour que je puisse comparer ?

Merci.
23/02/2008, 15h01
Qwazerty

SAlut
Bien sur
Le voici
A++
Qwaz
23/02/2008, 15h31
SKY33

Merci !

Je ne vois qu'un seul onglet, c'est normal ?

Ce qui dépasse 10 n'est pas inscrit dans l'onglet 1 donc OK, mais n'est pas inscrit dans l'onglet 2 non plus.
23/02/2008, 18h10
Qwazerty

Citation:

Envoyé par Qwazerty

SAlut
Bon je te fais ca mais maintenant pour le reste tu propose du code et on voit ce qui va pas, par ce que le je suis en train de faire le boulot a ta place et c'est pas le but de se forum ;)

Aurais tu, par hazard, oublié que nous somme sur un forum d'entraide, pas un forum ou les gens font tout ton boulot, je veux bien être gentil, mais il faudrait peut être aussi t'investir un peu dans ton projet et proposer des choses, des idées, le gros du code est fait, alors essais donc de le modifier pour faire ce que tu souhaite.
Et si tu rencontre des problèmes, tu ouvres un nouveau post pour poser une question précise ;)
++Qwaz

Voir 40 message(s) de cette discussion en une page