Discussion :

[nevpen]

VBA v6.5

Bonjour à tous,

J'ai un fichier récapitulatif des deals en cours qui est alimenté avec les nouveaux deals manuellement (car retraitement de données, onglet "deals 2015") et je reçois régulièrement une nouvelle extract Excel avec les nouveaux deals (onglets "new deals" que j'importe dans mon fichier). Entre deux mises à jour de mon onglet "deals 2015" à partir de la nouvelle extract, il peut arriver qu'un deal sorte et qu'un autre rentre sur une période antérieure (les deals sont affichés et classés par date). Il faut donc que j'applique ces changements sur mon onglet "deals 2015").

Mon objectif final est de faire matcher les deux onglets sur toutes les périodes : mon onglet alimenté manuellement vs celui que je reçois de ma source. Le risque opérationnel existe et je souhaite le réduire autant que possible.

Pour cela, j'ai une macro qui va me matcher les deals codes présents sur les périodes antérieures par mois ou trimestre sur les deux onglets (m'indiquant que le deal est toujours présent) en coloriant les cellules (des deux onglets) de manière à isoler les deals qui sortent, qui rentrent ou dont le montant varie entre deux majs.

Pour le moment la macro colorie bien les deals présents dans les deux onglets mais je bloque quand il s'agit de vérifier si le montant ne change pas pour ces deals.
Je souhaite que pour chaque deal déjà présent dans les deux onglets, excel vérifie que le montant reste inchangé (sur les deux onglets) et que si modification de montant il y a, il colorie la cellule du montant en rouge flashy.

NB :
Colonne E = deal code
Colonne J = montants

Le code ne fonctionne pas à partir de la ligne 31.

Je ne sais pas trop dans quel sens aller. Merci d'avance pour votre aide!

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
 
Sub New_prod_MFC()
'on désire comparer deux feuilles d'un même classeur
 
Dim Ret As Integer
Dim Msg As String
Dim MsgTitle As String
Msg = "Avez-vous séléctionné les mêmes périodes ?"
MsgTitle = "Contrôle"
Ret = MsgBox(Msg, vbYesNo, MsgTitle)
If Ret = vbNo Then
Exit Sub
Else
 
'on définit la couleur pour MFC
coul = 8
coul2 = 3
'pour chaque cellule de la colonne E de l'onglet "deals 2015"
For n = 2 To ActiveWorkbook.Sheets("deals 2015").Range("E65536").End(xlUp).Row
'pour chaque ligne de la colonne E de l'onglet source
  For m = 2 To ActiveWorkbook.Sheets("new deals").Range("E65536").End(xlUp).Row
 
    If InStr(ActiveWorkbook.Sheets("new deals").Range("E" & m), ActiveWorkbook.Sheets("deals 2015").Range("E" & n)) <> 0 Then
       ActiveWorkbook.Sheets("deals 2015").Range("E" & n).Interior.ColorIndex = coul
       ActiveWorkbook.Sheets("new deals").Range("E" & m).Interior.ColorIndex = coul
 
    End If
  Next m
Next n
 
For Each Cell In Worksheets("deals2015").Range("E:E")
If Worksheets("deals2015").Range("E" & n).Interior.ColorIndex = coul Then
 
'pour chaque cellule de la colonne E de l'onglet "deals 2015"
For n2 = 2 To ActiveWorkbook.Sheets("deals 2015").Range("J65536").End(xlUp).Row
'pour chaque ligne de la colonne E de l'onglet source
For m2 = 2 To ActiveWorkbook.Sheets("new deals").Range("J65536").End(xlUp).Row
 
           If ActiveWorkbook.Sheets("new deals").Range("J" & m2).Value <> ActiveWorkbook.Sheets("deals 2015").Range("J" & n2).Value Then
                ActiveWorkbook.Sheets("new deals").Range("J" & m2).Interior.ColorIndex = coul2
                End If
                End If
 
Next m2
Next n2
End Sub

Cordialement

Nevpen

[vinc_bilb]

Bonjour,

Essayez en L31

Code :

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

For Each Cell In Worksheets("deals2015").Range("E:E").Cells

[nevpen]

Bonjour,


Je viens d'essayer et j'obtiens un compile error : block if without end if.

Il n'y a aucune condition if sans end if.

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
 
'A partir de la ligne 31
For Each Cell In Worksheets("deals2015").Range("E:E").Cells
If Worksheets("deals2015").Range("E" & n).Interior.ColorIndex = coul Then
 
'pour chaque cellule de la colonne E de l'onglet "deals 2015"
For n2 = 2 To ActiveWorkbook.Sheets("deals 2015").Range("J65536").End(xlUp).Row
'pour chaque ligne de la colonne E de l'onglet source
For m2 = 2 To ActiveWorkbook.Sheets("new deals").Range("J65536").End(xlUp).Row
 
           If ActiveWorkbook.Sheets("new deals").Range("J" & m2).Value <> ActiveWorkbook.Sheets("deals 2015").Range("J" & n2).Value Then
                ActiveWorkbook.Sheets("new deals").Range("J" & m2).Interior.ColorIndex = coul2
                End If
 
 
       Next m2
    Next n2
End If
Next
End Sub

Merci d'avance.

[vinc_bilb]

et celui en ligne 11?

Code :

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

1
2
3
If Ret = vbNo Then
Exit Sub
Else

[nevpen]

Merci vinc_bilb pour ton aide.

Effectivement je l'ai corrigé entre temps et il est avant le End Sub.

Je mets mon code actuel :

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
 
'PARTIE 1
Sub New_prod_MFC()
'on désire comparer deux feuilles d'un même classeur
Dim Ret As Integer
Dim Msg As String
Dim MsgTitle As String
Msg = "Avez-vous séléctionné les mêmes périodes ?"
MsgTitle = "Contrôle"
Ret = MsgBox(Msg, vbYesNo, MsgTitle)
If Ret = vbNo Then
Exit Sub
Else
 
coul = 8
coul2 = 3
'pour chaque cellule de la colonne E de l'onglet "deals 2015"
For n = 2 To ActiveWorkbook.Sheets("deals 2015").Range("E65536").End(xlUp).Row
'pour chaque ligne de la colonne E de l'onglet source
  For m = 2 To ActiveWorkbook.Sheets("new deals").Range("E65536").End(xlUp).Row
 
    If InStr(ActiveWorkbook.Sheets("new deals").Range("E" & m), ActiveWorkbook.Sheets("deals 2015").Range("E" & n)) <> 0 Then
       ActiveWorkbook.Sheets("deals 2015").Range("E" & n).Interior.ColorIndex = coul
       ActiveWorkbook.Sheets("new deals").Range("E" & m).Interior.ColorIndex = coul
    End If
  Next m
Next n
 
'PARTIE 2
 
n2 = ActiveWorkbook.Sheets("deals 2015").Range("J65536").End(xlUp).Row
m2 = ActiveWorkbook.Sheets("new deals").Range("J65536").End(xlUp).Row
 
For Each cell In Worksheets("deals 2015").Range("E:E").Cells
If Worksheets("deals 2015").Range("E" & n).Interior.ColorIndex = coul Then
 
        If ActiveWorkbook.Sheets("new deals").Range("J" & m2).Value <> ActiveWorkbook.Sheets("deals 2015").Range("J" & n2).Value Then
        ActiveWorkbook.Sheets("deals 2015").Range("J" & n2).Interior.ColorIndex = coul2
        End If
        End If
Next
End If
End Sub

Avec ce code je n'ai pas d'erreur. Le souci c'est que pour les montants, il va juste checker le dernier deal (via la dernière ligne - variable LR)
Je vais réessayer avec des "For".

Je viens de modifier mon code et la macro se lance (cad pas de message d'erreur) sauf que la seconde partie du code ne fonctionne pas. J'ai modifié à la mano des montants et ceux-ci ne sont pas coloriés en rouge.

Pour rappel, j'aimerais vérifier que les montants des deals codes matchés (première partie du code) soit comparés et s'ils ne correspondent pas, colorier la cellule en rouge.

Merci d'avance.

[vinc_bilb]

Bonjour,
Et bien là, je pense qu'il me faut un bout d'exemple, je n'ai pas trop le temps de m'en recréer un
Suggestion (sous réserve que ça soit géré par Excel 2007 mais je pense que oui), il vaudrait mieux

• Sol1 passer par un style plutot que par un Interior.ColorIndex, plus facile à manipuler et à changer
• Sol2 passer par le specialCells puisque vous pouvez accéder directement aux cellules ayant le même format (je n'ai jamais essayé cette possibilité, mais le Range.SpecialCells est TRES TRES puissant et rapide)

xlCellTypeSameFormatConditions -Cells having the same format.

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
 
' Trouver les cellules dont le style est celui spécifié (Style_name)
Set usd_rng = Wsh.UsedRange
        Set Res_Rng = Nothing
 
            ' Parse all the cells in the used range
        For Each cl In usd_rng
 
                ' Build the result range if styles is fitting and rise a flag if found
            If cl.Style = Style_name Then
 
                cnt_cl = cnt_cl + 1
 
                If fnd_stl = False Then
                    Set Res_Rng = cl
                    fnd_stl = True
                    Else: Set Res_Rng = Union(Res_Rng, cl)
                End If
 
            End If
 
        Next cl