Discussion :

[Ozer45]

Bonjour,

Je cherche à effectuer plusieurs manipulations de mon tableau ci joint :

sub manip_tableau()

dim i as long
dim maxrow as long
maxrow = currentws.Range("A65536").End(xlUp).Row

For i = 4 to maxrow
SI Cellule(i,1)="done" alors cellule(date of delivery).color=bleu
fin si

si semaine de la cellule(date of delivery) est inferieur à 2*semaine en cours (date of delivery).color =rouge
fin si

si semaine de la cellule(date of delivery) est isuperieur 2*semaine en cours alors cellule(date of delivery).color =rouge
fin si

ensuite:
classer le tableau suivant les ordres de priorités

si priorité =1 en premier jusqu'a priorité n alors classer les lignes suivant les priorités
fin si

si priorité 9 modifier en priorité 5 alors mettre à jour le tableau
fin si

next i

Mon probleme, c'est que je sais pas comment recuperer la semaine en cours et effectuer ma comparaison avec la colonne "date of delivery".


Merci pour votre aide.

[BlueMonkey]

Bonjour,

Mon probleme, c'est que je sais pas comment recuperer la semaine en cours [...]

Pour récupérer le numéro de la semaine en cours : DatePart("ww", Now(), vbMonday, vbFirstFourDays)

et effectuer ma comparaison avec la colonne "date of delivery".

voir la FAQ sur les manipulation de cellules
Et bien sur il faut lire aussi les cours et tutoriels pour apprendre Excel.

[Ozer45]

j'ai essayé d'ecrire une macro pour les couleurs mais j'arrive toujours pas à faire la comparaison des semaines. J'ai créé une fonction dans la cellule A1 qui recupere la semaine en cours. Cependant je sais pas comment effectuer la comparaison en semaine.

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
 
 currentws.Range(6 & ":" & maxrow).Select
    For i = 6 To maxrow
        If currentws.Cells(i, 1).Value = "Done" Then
        currentws.Cells(i, 8).Interior.ColorIndex = xlNone
        currentws.Cells(i, 8).Interior.Color = RGB(54, 204, 204) 'bleu
        End If
 
        If Mid(currentws.Cells(i, 8), 9) >= 2 * currentws.Cells(1, 1) Then
        currentws.Cells(i, 8).Interior.ColorIndex = xlNone
        currentws.Cells(i, 8).Interior.Color = RGB(0, 51, 0) 'vert
        End If
 
        If Mid(currentws.Cells(i, 8), 9) < 2 * currentws.Cells(1, 1) Then
        currentws.Cells(i, 8).Interior.ColorIndex = xlNone
        currentws.Cells(i, 8).Interior.Color = RGB(255, 0, 0) 'rouge
        End If
    Next i

[/QUOTE]

quelqu'un pourrais m'aider??

[Ozer45]

j'ai finalement trouvé la solution.


formule de la semaine en cours en A1:=ENT(MOD(ENT((AUJOURDHUI()-2)/7)+0,6;52+5/28))+1

cette formule retourne la valeur 7 pour la semaine du 13 au 19 fevrier 2012

Si jamais ca peut servir :

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
sub macro ()
    Dim i As Long
    Dim j As Long
    Dim maxcol As Long
    Dim maxrow As Long
    Dim m As Long 'variable qui recupere la valeur de la semaine de la cellule A1
 
    maxrow = currentws.Range("A65536").End(xlUp).Row
    maxcol = currentws.Cells(5, currentws.Cells.Columns.Count).End(xlToLeft).Column
    'effacement des couleurs 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For i = 6 To maxrow
        For j = 1 To maxcol
        currentws.Cells(i, j).Interior.ColorIndex = xlNone
        Next j
    Next i
    Application.EnableEvents = True
 
'boucle pour les couleurs
    For i = 6 To maxrow
    m = currentws.Cells(1, 1).Value 'variable de la semaine en cours
        currentws.Range(6 & ":" & maxrow).Select
 
        If currentws.Cells(i, 1).Value = "Done" And Mid(currentws.Cells(i, 8), 12) < m Then
        currentws.Cells(i, 8).Interior.ColorIndex = xlNone
        currentws.Cells(i, 8).Interior.Color = RGB(54, 204, 204) 'bleu
        End If
 
        If Mid(currentws.Cells(i, 8), 12) >= 2 * m Then
        Debug.Print Mid(currentws.Cells(i, 8), 11)
        currentws.Cells(i, 8).Interior.ColorIndex = xlNone
        currentws.Cells(i, 8).Interior.Color = RGB(0, 51, 0) 'vert
        End If
 
        If Mid(currentws.Cells(i, 8), 12) < 2 * m Then
        currentws.Cells(i, 8).Interior.ColorIndex = xlNone
        currentws.Cells(i, 8).Interior.Color = RGB(255, 0, 0) 'rouge
        End If
    Next i
   'pour classer les variables suivant les priorités de 1 à n
 currentws.Range(6 & ":" & maxrow).Select
    Selection.Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess,_
    ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    dataoption1:=xlSortNormal
    Application.ScreenUpdating = True
 
end sub