[VBA] comparaison et MFC

Version imprimable

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:

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

19/02/2015, 15h42
vinc_bilb

Bonjour,

Essayez en L31

Code:

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

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:

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.

19/02/2015, 16h47
vinc_bilb
et celui en ligne 11?
Code:

1 2 3 If Ret = vbNo Then Exit Sub Else

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:

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.

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:

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

Bonjour à tous,

n'ayant pas d’exemple sous la main je n'ai pas testé le code, mais je pense que le principe est la:

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
Option Explicit
 
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 Each cell In Worksheets("deals 2015").UsedRange.Range("E:E").Cells
    'défini une celulle a chercher dans l'onglet "new deals" contenant la value de la cellule de l'onglet "deals 2015"
    Set new_deal = ActiveWorkbook.Worksheets("new deals").UsedRange.Range("E:E").Find(cell.Value, , xlValues)
    'si une valeur est trouvée
    If Not new_deal Is Nothing Then
        'on colorie la celulle en cours et la celulle trouvée
        new_deal.ColorIndex = coul
        cell.ColorIndex = coul
        ' si les deux montants sont différents
        If cell.Offset(, 5).Value <> new_deal.Offset(, 5).Value Then
            'on colorie la celulle  du prix en cours en rouge
            cell.Offset(, 5).Interior.ColorIndex = coul2
        End If
    End If
Next cell
End Sub

il n'est pas utile de parcourir deux fois l'onglet "deal 2015" ça peut vite devenir long, la méthode find pointe directement la celulle cherché, c'est bien partique.

20/02/2015, 14h32
nevpen

Merci à vous deux !

@vinc_bilb

Je ne suis peut-être pas aussi à l'aise avec vba que ce que tu penses. :)
Je vais fouiller tes solutions mais il me semble qu'elles demandent un niveau un peu plus avancé que le mien.

@Aposto

Devant travailler sur le fichier aujourd'hui, j'essaye de faire au plus vite. Je viens de tester ton code.
Il y a cependant une erreur (peut-être que je n'ai pas adapté une chose) qui m'arrête sur la ligne 15 : "variable not defined"

Si je mets un Dim coul as ColorFormat pour coul et coul2, il se produit la même erreur sur cell (ligne 19). Je pense que l'erreur ne vient pas de là.

Je viens d'ajuster la macro, il manquait ".Interior" avant les ".ColorIndex". Maintenant cela fonctionne !

Il me reste 2-3 ajustements car la macro balaye toute la colonne E dans l'onglet "deals 2015" et colorie toutes les cellules vides en dessous de la table jusqu'à la dernière ligne d'excel (1kk et quelques). Il me suffit de définir la plage avec une première ligne et une dernière ligne, c'est dans mes cordes. :)

Encore merci à vous deux, vous avez été parfaits !