Discussion :

[rayba89]

Bonjour,

Je pars d'une feuille excel que je dois la comparer à une autre feuille afin de la mettre à jour, il s'agit d'une colonne "identifiants" et les autres colonnes representent des attributs pour chaque identifiant ( voir le fichier en pj)
En gros, voici par etape ce que je dois faire:
-trouver le meme identifiant dans les deux feuilles
-pour cet identifiant, comparer les cellules de chaque attribut
-pour chaque terme dans les cellules :
- S'il existe dans le tableau 1 mais pas dans le tableau 2
--> le mettre en bold dans le tableau 1

-S'il existe dans le tableau 1 et le tableau 2
--> copier le format de ce terme du tableau 2 au tableau 1

Faire cette boucle pour tous les identifiants presents dans le tableau 1!

J'avais developpé un code(avec l'aide sur ce forum) qui me permet de comparer deux cellules, cellA et cellB par exemple,terme par terme.
si un terme existe dans cellA mais pas dans cellB alrs je le rajoute dans cellB.
voir le code de la fonction "compare".

Dans mon cas actuel j'ai pas besoin de le rajouter, mais juste de detecter s'il existe dans cellB, et si c'est le cas copier son format.

De plus j'ai developpé un autre code me permettant de copier le contenu d'une cellule dans une autre tout en respectant le format de chaque terme.

Voir le code de la fonction "copy format".

Ce que j'aimerais faire, c'est en quelque sorte fusionner ces deux fonctions pour en finir avec une fonction qui trouve le meme identifiant dans les deux feuilles, compare le contenu de leurs attributs c.a.d de de deux cellules cellA et cellB, trouver les termes dans cellA qui existent dans la cellB, et copier leur format de la cellA à la cellB, et mettre tous les autres termes (pas en commun) dans cellA en Bold.

Dans le fichier excel j'ai donné un exemple illustrant le resultat attendu!

Merci d'avance pour l'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
Function Compare$(ByVal S1$, ByVal S2$)
         Dim SP$()
         SP = Split(S1, ",")
 
         For Each Mot In Split(S2, ",")
             If IsError(Application.Match(Mot, SP, 0)) Then
                 ReDim Preserve SP(UBound(SP) + 1)
                 SP(UBound(SP)) = Mot
             End If
         Next
 
         Completer = Join(SP, ",")
End Function
 
 
Private Sub CommandButton1_Click()
 
Cells(5, 3).Value = Completer(Cells(5, 3).Value, Cells(4, 3).Value)

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Private Sub copy_fomrat()
 
Dim old As Workbook
Dim filter As String
Dim caption As String
Dim sourceFilename As String
Dim sourceWorkbook As Workbook
Dim targetWorkbook As Workbook
Set targetWorkbook = Application.ActiveWorkbook
 
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
 
browseFilename = Application.GetOpenFilename(filter, , caption)
 
Set browseWorkbook = Application.Workbooks.Open(browseFilename)
 
Dim oldSheet As Worksheet
Set oldSheet = targetWorkbook.Worksheets(3)
Dim browseSheet As Worksheet
Set browseSheet = browseWorkbook.Worksheets(1)
Dim newSheet As Worksheet
Set newSheet = targetWorkbook.Worksheets(4)
 
Dim lngRow As Long
lngRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
' la plage est tjrs fixe, le nbre de DMD peut depasser le 200 -> mettre lenght maximal comme variable
oldSheet.Range("A1", "T200").Value = browseSheet.Range("A1", "T200").Value
newSheet.Range("A1", "T200").Value = browseSheet.Range("A1", "T200").Value
 
    For l = 1 To lngRow
        lenght_range_F = Len(browseSheet.Range("F" & l))
        lenght_range_G = Len(browseSheet.Range("G" & l))
        lenght_range_H = Len(browseSheet.Range("H" & l))
 
        'oldSheet.Range("F" & l).Value = browseSheet.Range("F" & l).Value
        'newSheet.Range("F" & l).Value = browseSheet.Range("F" & l).Value
 
        For i = 1 To lenght_range_F
            With oldSheet.Range("F" & l).Characters(i, 1).Font
                .Bold = browseSheet.Range("F" & l).Characters(i, 1).Font.Bold
                .Name = browseSheet.Range("F" & l).Characters(i, 1).Font.Name
                .Color = browseSheet.Range("F" & l).Characters(i, 1).Font.Color
            End With
 
            With newSheet.Range("F" & l).Characters(i, 1).Font
                .Bold = browseSheet.Range("F" & l).Characters(i, 1).Font.Bold
                .Name = browseSheet.Range("F" & l).Characters(i, 1).Font.Name
                .Color = browseSheet.Range("F" & l).Characters(i, 1).Font.Color
            End With
        Next i
 
 
        For j = 1 To lenght_range_G
            With oldSheet.Range("G" & l).Characters(j, 1).Font
                .Bold = browseSheet.Range("G" & l).Characters(j, 1).Font.Bold
                .Name = browseSheet.Range("G" & l).Characters(j, 1).Font.Name
                .Color = browseSheet.Range("G" & l).Characters(j, 1).Font.Color
            End With
 
            With newSheet.Range("G" & l).Characters(j, 1).Font
                .Bold = browseSheet.Range("G" & l).Characters(j, 1).Font.Bold
                .Name = browseSheet.Range("G" & l).Characters(j, 1).Font.Name
                .Color = browseSheet.Range("G" & l).Characters(j, 1).Font.Color
            End With
        Next j
 
        For h = 1 To lenght_range_H
            With oldSheet.Range("H" & l).Characters(h, 1).Font
                .Bold = browseSheet.Range("H" & l).Characters(h, 1).Font.Bold
                .Name = browseSheet.Range("H" & l).Characters(h, 1).Font.Name
                .Color = browseSheet.Range("H" & l).Characters(h, 1).Font.Color
            End With
 
            With newSheet.Range("H" & l).Characters(h, 1).Font
                .Bold = browseSheet.Range("H" & l).Characters(h, 1).Font.Bold
                .Name = browseSheet.Range("H" & l).Characters(h, 1).Font.Name
                .Color = browseSheet.Range("H" & l).Characters(h, 1).Font.Color
            End With
        Next h
 
 
    Next l
 
oldSheet.Name = "old_follow-up"
newSheet.Name = "New_follow-up"
browseWorkbook.Close
 
End Sub

L'algo de la fonction que je souhaite coder:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
'trouver le meme identifiant dans les deux feuille, pour cet identifiant:
Function Compare$(ByVal S1$, ByVal S2$)
         Dim SP$()
         SP = Split(S1, ",")
 
         For Each Mot In Split(S2, ",")
             If IsError(Application.Match(Mot, SP, 0)) Then
             ->mettre ce mot en bold 
             Elsif -> copier le format de ce mot de S2 à S1
         Next
 
         End Function