Discussion :

[SPG except in VBA]

Bonjour à tous, et au forum !

Après avoir chercher et essayer pas mal de codes cette après-midi je me tourne vers la communauté !

Mes données : Sur la Colonne A j'ai des ID correspondant à numéro d'offres, puis sur le reste de chaques lignes les résultats de ces offres.
J'ai deux feuilles avec ces données sur 2 différentes périodes (Feuille1 période X, Feuille2 période Y) sur max 100 lignes et max 10 colonnes (cela peux varier, mais ca reste petit).

Ce que je veux faire : Si une offre (ID) est présente sur les deux feuilles (donc les 2 périodes) je veux comparer les résultats en mettant en rouge ou vert les cellules de la période Y (Feuille2) selon si la valeur à l'intérieure à augmenter ou diminuer par rapport à la valeur en X (Feuille1).

Ce que j'ai : Après mes recherces et mes essais j'ai quelque chose. Je me suis perdue dans mes variables et je ne maitrise pas les Range, mais la logique du code est assez simple.

Info supplémentaire : Les données des deux feuilles proviennent d'un tableau pivot, je trouvais plus simple pour moi de d'abord copié coller mes données dans de nouvelle feuille pour faire cette manip de comparaison. Une fois la comparaison effectuer je vais copier les données comme image pour les importer dans un PowerPoint. Si vous trouvez qu'il est plus simple de garder la relation avec le tableau pivot, je suis prêt à vous suivre !

Je ne m'attend pas à avoir une solution toute cuite, mais plutôt des guidelines pour pouvoir comprendre ce que je fais ! Ci-joint un fichier exemple, si besoin

Merci aux lectures/-trices !

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
 
Sub Comparaison()
Dim rng1 As Range
Dim rng2 As Range
Dim cell1 As Range
Dim cell2 As Range
Dim i As Integer
Dim j As Integer
Dim egal As Boolean
 
Set rng1 = Worksheets("Sheet1").UsedRange.Columns("A:A")
Set rng2 = Worksheets("Sheet2").UsedRange.Columns("A:A")
 
'Application.ScreenUpdating = False
For Each cell1 In rng1
  For Each cell2 In rng2
    egal = True
    For i = 1 To cell1.Cells.Count
        'For j = 1 To cell2.Cells.Count
        If cell1.Cells(1, i).Value <> cell2.Cells(1, i).Value Then egal = False ' Ici je regarde si j'ai des offres en commun, je suis arrivé à la faire marché fût un moment, mais impossible depuis que j'ai fait des modifs
        'Next j
    Next i
    If egal Then
       'Ici une formule pour comparer et colorier les cellules en feuille 2      
    End If
  Next cell2
Next cell1
'Application.ScreenUpdating = True
 
End Sub