Discussion :

[azerty1956]

Salut,

Je suis débutant en VBA.

J'ai un fichier Excel avec deux sheets, sur la sheet 3 je récupère les données se trouvant sur la colonne R de la sheet 1.

Pour ce qui est de la structure des 2 sheets:

Dans la sheet 3 de la cell(1,4) jusqu'à la cell(1,97) j'ai un ensemble de clés, ces dernières sont les mêmes que les clés que je pourrais avoir avec la concaténation des cells (k,6) à (k,17) sur la sheet 1.

Pour le tableau de la sheet 3 j'ai 356 lignes pour 97 colonnes.

Pour la sheet 1 j'ai 24 colonnes et 3402 lignes. Le nombre des lignes pouvant changé sur cette sheet j’ai une boucle qui s'arrête à la dernière ligne renseignée avec un find qui s'appuie sur la comparaison entre la colonne Y de la sheet 1 et de la colonne C de la sheet 3.

Dans les cellules de ma sheet 3 je récupère les données de la colonne R de la sheet 1.

J’arrive à remplir mon tableau comme il faut, mais le problème c’est que je souhaiterais mettre les valeurs de la colonne R correspondant au type 2 en commentaire dans les cellules correspondantes.
Je souhaite aussi insérer les valeurs temporaires (celle ayant une enddate différente du 31/12/2099 sur la colonne V sheet1) en commentaire.


Je ne sais pas comment je pourrais introduire ça dans ma boucle ??

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
Sub test()
Dim i As Integer, j As Integer, k As Integer
Dim cle As String, CurrString As String
Dim FL1 As Worksheet 'Feuille "sheet3"
Dim FL2 As Worksheet 'Feuille "sheet1"
Dim c As Range, LigDeb As String
Dim Dtype As String
   Application.ScreenUpdating = False
'Instanciation des feuilles de calculs concernées (pour simplifier le code à venir)
     Set FL1 = Worksheets("sheet3")
     Set FL2 = Worksheets("sheet1")
    CurrString = ""
    j = 4
    Application.ScreenUpdating = False
    While FL1.Cells(1, j).Value <> ""
 
        For i = 2 To 360
'La clé est constituée de la colonne 3 d'une même ligne & de la colonne J de la ligne 1
            cle = FL1.Cells(i, 3).Value & FL1.Cells(1, j).Value
 
'Recherche de la valeur de FL1.Cells(i,3) dans la colonne F de FL2
            With FL2.Range("Y2:Y" & Split(FL2.UsedRange.Address, "$")(4))
                Set c = .Find(FL1.Cells(i, 3).Value)
                If Not c Is Nothing Then
                    LigDeb = c.Address
                    Do
                        k = c.Row
                        CurrString = FL2.Cells(k, 25).Value & FL2.Cells(k, 26).Value
                        If CurrString = cle Then
                           FL1.Cells(i, j) = FL2.Cells(k, 18)
                          'Je récupère le type qui est en colonne C
                           Dtype = FL2.Cells(k, 3)
                           With FL1.Cells(i, j).Font
                          Select Case Dtype
                           Case "type1"
                               .Bold = True
                               .ColorIndex = xlAutomatic
                           Case "type2"
                               .Bold = False
                               .ColorIndex = 3
                           Case "type3"
                               .Bold = False
                               .ColorIndex = 5
                           Case Else
                               .Bold = False
                               .ColorIndex = xlAutomatic
                        End Select
                       End With
                    End If
 
'Cette recherche ne se poursuit que si FL1.Cells(i, 1) a été trouvé
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> LigDeb
                End If
            End With
        Next i
'Ajoute une ligne à FL1
        j = j + 1
    Wend
   Application.ScreenUpdating = True
End Sub

Dans le code précedent j'avais affecter par types des couleurs différentes.
Finalement je pense que ca serait mieu que je mette le type2 en commentaire.
comment je peux faire ??
Voir pièce jointe, c'est un petit bout de mon tableau .

N’hésitez pas à exposer vos idées.

Merci d’avance.

[Qwazerty]

Salut
Pourrais tu dans ton fichier mettre les commentaire ou tu souhaites les avoir et avec le contenu que tu souhaite obtenir
a++
Qwaz

[azerty1956]

Merci pour ta réponse Qwazerty,

en fait ce que je veux faire, c'est au lieu d'insérer normalement les valeurs de type 2 dans une cellule comme ca se fait tout naturellement avec ce code, je souhaite l'insérer en commentaire dans la cellule correspondante...avec un contenu de commentaire : type 2 "valeur"

je souhaite aussi faire une requete sur la colonne V ou il y a les enddate.dans le cas ou enddate <> 31/12/2099 mettre la valeur (présente dans colonne R sheet1) en commentaire aussi dans la cellule correpondante sheet3...Avec un contenu de commentaire : "valeur" jusqu'à "enddate"

En fait j'ai laissé tombé la concaténation qui me permettais d'affecter plusieurs valeurs dans les cellules correpondantes puisque ca fesai moche.
Et puisque les valeurs de type2 et les valeurs temporaires ( enddate<>31/12/2099) ne sont pas très importantes je souhaite les mettre en commentaire dans les cellules correspondates sheet3.

voila voila, si ce n'est pas clair, dis le moi comme ca j'essaierai de mieux préciser.

En gros dans le cas de valeurs temporaires ( enddate<>31/12/2099) :
au lieu d'insérer la valeur dans le cellule correspondante dans le tableau sheet3, le mettre plutot en commentaire dans cette cellule.

Dans le cas de valeurs correpondants à type2 : faire la meme chose que précédemment


NB : dans mon code je ne parle pas du critère de temps (colonne V sheet1) à aucun moment, je ne sais pas comment je pourrais l'insérer (en sachant que les valeurs temporaire peuvent concerner les trois types 1,2 et 3)??

[Qwazerty]

Salut
Je dirais en modifiant le case Type2 comme suit

Code :

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

1
2
3
4
5
6
 
                            Case "type2"
                                'Ici on met la valeur en commentaire
                                FL1.Cells(i, j).AddComment "Type 2 : " & FL2.Cells(k, 3).Offset(0, 15)
                                .Bold = False
                                .ColorIndex = 3

A essayer
++
Qwaz

[azerty1956]

Merci Qwazerty ca me met le commentaire mais ca me laisse aussi la valeur dans la cellule, je souhaite avoir la valeur juste en commentaire....je ne sais pas ce qui cloche dans mon code....sinon

Code :

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

Offset(0, 15)

ca correpond à quoi en fait?

Pour les temporaires, je dois faire quoi à ton avis ?

Merci d'avance pour ton aide précieuse

[Qwazerty]

Re
Comme ça ça ira mieux

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
                        If CurrString = cle Then
 
                            If CDate(FL2.Cells(k, 22)) = #12/31/2099# Then
                                'Je récupère le type qui est en colonne C
                                Dtype = FL2.Cells(k, 3)
                                With FL1.Cells(i, j).Font
                                    Select Case Dtype
                                    Case "type1"
                                        .Bold = True
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    Case "type2"
                                        'Ici on met la valeur en commentaire
                                        FL1.Cells(i, j).AddComment "Type 2 : " & FL2.Cells(k, 18)
                                        .Bold = False
                                        .ColorIndex = 3
                                    Case "type3"
                                        .Bold = False
                                        .ColorIndex = 5
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    Case Else
                                        .Bold = False
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    End Select
                                End With
                            Else
                                FL1.Cells(i, j).AddComment "Tmp : " & FL2.Cells(k, 18)
                            End If
                        End If

Offset(y,x) decale la case pointé par le programme de y lignes et de x colonnes
ainsi

Code :

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

Range("A1").Offset(1,2).value = "Ici"

Mettra le mots "Ici" dans la cellule C2

Je l'ai retiré du programme il n'était pas utile je l'ai intégré a la valeur de cells(k,3+15=18)

J'ai modifié pour l'histoire de la date aussi
++
Qwaz

[azerty1956]

Merci Qwazerty
Le code marche bien
Il ya un problème :
Dans le cas où j’aurais une valeur de type 2 qui est temporaire.
Le code bug, est ce que je dois faire une concaténation pour prendre en compte ce cas la ?
(Pour avoir dans ce cas la un commentaire du style: type2 : valeur, Tmp : date)

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
 
Sub testlast()
 
Dim i As Integer, j As Integer, k As Integer
Dim cle As String, CurrString As String
Dim FL1 As Worksheet 'Feuille "sheet3"
Dim FL2 As Worksheet 'Feuille "sheet1"
Dim c As Range, LigDeb As String
Dim Dtype As String
    Sheets("sheet3").Range("D2:IV356").Select
    Cells.ClearComments
    Selection.ClearContents
   Application.ScreenUpdating = False
'Instanciation des feuilles de calculs concernées (pour simplifier le code à venir)
     Set FL1 = Worksheets("sheet3")
     Set FL2 = Worksheets("sheet1")
    CurrString = ""
    j = 4
    Application.ScreenUpdating = False
    While FL1.Cells(1, j).Value <> ""
 
        For i = 2 To 360
'La clé est constituée de la colonne 3 d'une même ligne & de la colonne J de la ligne 1
            cle = FL1.Cells(i, 3).Value & FL1.Cells(1, j).Value
 
'Recherche de la valeur de FL1.Cells(i,3) dans la colonne F de FL2
            With FL2.Range("Y2:Y" & Split(FL2.UsedRange.Address, "$")(4))
                Set c = .Find(FL1.Cells(i, 3).Value)
                If Not c Is Nothing Then
                    LigDeb = c.Address
                    Do
                        k = c.Row
                        CurrString = FL2.Cells(k, 25).Value & FL2.Cells(k, 26).Value
                        If CurrString = cle Then
                            If CDate(FL2.Cells(k, 22)) = #12/31/2099# Then
                                'Je récupère le type qui est en colonne C
                                Dtype = FL2.Cells(k, 3)
                                With FL1.Cells(i, j).Font
                                    Select Case Dtype
                                    Case "type1"
                                        .Bold = True
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    Case "type2"
                                        'Ici on met la valeur en commentaire
                                        FL1.Cells(i, j).AddComment
                                        FL1.Cells(i, j).Comment.Visible = False
                                        FL1.Cells(i, j).Comment.Text Text:="Warning:" & FL2.Cells(k, 18)
                                        .Bold = True
                                        '.ColorIndex = 3
                                    Case "type3"
                                        .Bold = False
                                        .ColorIndex = 5
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    Case Else
                                        .Bold = False
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    End Select
                                End With
                            Else
                                FL1.Cells(i, j).AddComment "Tmp : " & FL2.Cells(k, 18)
                            End If
                        End If
 
 
'Cette recherche ne se poursuit que si FL1.Cells(i, 1) a été trouvé
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> LigDeb
                End If
            End With
        Next i
'Ajoute une ligne à FL1
        j = j + 1
    Wend
   Application.ScreenUpdating = True
End Sub

NB: je supprime les commentaires au tout début avant de les insérer puisque le code bug puisqu'il n'arrive pas à écraser les anciens commentaires et les remplacer par les nouveaux.

Merci d'avance pour vos conseils et votre aide.

[Qwazerty]

Salut
Je dirais qu'il faut le rajouter dans la partie du code qui gere le temporaire,

Code :

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

1
2
                            Else
                                FL1.Cells(i, j).AddComment "Tmp : " & FL2.Cells(k, 18)

En ajoutant quelque chose comme ça

Code :

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

If FL2.Cells(k, 3) = "Type 2" Then FL1.Cells(i, j).comment.text = FL1.Cells(i, j).comment.text & ch(10) & "Type 2 : " & FL2.Cells(k, 18)

Quelque chose comme ça, je n'ai pas vérifié le code mais l'idée est la.

a++
Qwaz

[azerty1956]

Merci Qwazerty

J'ai fait ca mais ca ne marche pas

dans le cas ou on a une valeur de type 2 et une valeur temporaire de type différent il bug parcequ'il n'arrive pas à mettre le deuxième commentaire.
Je pense qu'il faudrait faire une condition du style : si il ya un commentaire existant alors ajouter un deuxième commentaire

Je ne sais pas comment traduire ca en code ? et je ne sais pas si c'est le bon raisonnement non plus...

Mais en tout cas ce qui est sur c'est qu'il fait un bug quand il s'agit d'ajouter le deuxième commentaire..

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
Sub test21()

Dim i As Integer, j As Integer, k As Integer
Dim cle As String, CurrString As String
Dim FL1 As Worksheet 'Feuille "sheet3"
Dim FL2 As Worksheet 'Feuille "sheet1"
Dim c As Range, LigDeb As String
Dim Dtype As String
    Sheets("sheet3").Cells.Select
    Cells.ClearComments
   Application.ScreenUpdating = False
'Instanciation des feuilles de calculs concernées (pour simplifier le code à venir)
     Set FL1 = Worksheets("sheet3")
     Set FL2 = Worksheets("sheet1")
    CurrString = ""
    j = 4
    Application.ScreenUpdating = False
    While FL1.Cells(1, j).Value <> ""
       
        For i = 2 To 390
'La clé est constituée de la colonne 3 d'une même ligne & de la colonne J de la ligne 1
            cle = FL1.Cells(i, 3).Value & FL1.Cells(1, j).Value
            
'Recherche de la valeur de FL1.Cells(i,3) dans la colonne F de FL2
            With FL2.Range("Y2:Y" & Split(FL2.UsedRange.Address, "$")(4))
                Set c = .Find(FL1.Cells(i, 3).Value)
                If Not c Is Nothing Then
                    LigDeb = c.Address
                    Do
                        k = c.Row
                        CurrString = FL2.Cells(k, 25).Value & FL2.Cells(k, 26).Value
                        If CurrString = cle Then
                            If CDate(FL2.Cells(k, 22)) = #12/31/2099# Then
                                'Je récupère le type qui est en colonne C
                                Dtype = FL2.Cells(k, 3)
                                With FL1.Cells(i, j).Font
                                    Select Case Dtype
                                    Case "type1"
                                        .Bold = True
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    Case "type2"
                                        'Ici on met la valeur en commentaire
                                        FL1.Cells(i, j).AddComment
                                        FL1.Cells(i, j).Comment.Visible = False
                                        FL1.Cells(i, j).Comment.Text Text:="type2:" & FL2.Cells(k, 18) & FL2.Cells(k, 19)
                                        .Bold = True
                                        '.ColorIndex = 3
                                    Case "type3"
                                        .Bold = False
                                        .ColorIndex = 5
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    Case Else
                                        .Bold = False
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    End Select
                                End With
                            Else
                                If FL2.Cells(k, 3) = "type2" Then FL1.Cells(i, j).Comment.Text = FL1.Cells(i, j).Comment.Text & Chr(10) & "Tmp : " & FL2.Cells(k, 18) & " till " & FL2.Cells(k, 22)
                                If FL2.Cells(k, 3) = "type1" Then FL1.Cells(i, j).Comment.Text = FL1.Cells(i, j).Comment.Text & Chr(10) & "Tmptype1 : " & FL2.Cells(k, 18) & " till " & FL2.Cells(k, 22)
                                If FL2.Cells(k, 3) = "type3" Then FL1.Cells(i, j).Comment.Text = FL1.Cells(i, j).Comment.Text & Chr(10) & "Tmptype3 : " & FL2.Cells(k, 18) & " till " & FL2.Cells(k, 22)                                
                            End If
                        End If


'Cette recherche ne se poursuit que si FL1.Cells(i, 1) a été trouvé
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> LigDeb
                End If
            End With
        Next i
'Ajoute une ligne à FL1
        j = j + 1
    Wend
   Application.ScreenUpdating = True
   Set FL1 = Nothing
   Set FL2 = Nothing
End Sub

[Qwazerty]

Salut
Et ainsi ?

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
90
91
Sub test21()
 
Dim i As Integer, j As Integer, k As Integer
Dim cle As String, CurrString As String
Dim FL1 As Worksheet 'Feuille "sheet3"
Dim FL2 As Worksheet 'Feuille "sheet1"
Dim c As Range, LigDeb As String
Dim Dtype As String
    Sheets("sheet3").Cells.Select
    Cells.ClearComments
   Application.ScreenUpdating = False
'Instanciation des feuilles de calculs concernées (pour simplifier le code à venir)
     Set FL1 = Worksheets("sheet3")
     Set FL2 = Worksheets("sheet1")
    CurrString = ""
    j = 4
    Application.ScreenUpdating = False
    While FL1.Cells(1, j).Value <> ""
 
        For i = 2 To 390
'La clé est constituée de la colonne 3 d'une même ligne & de la colonne J de la ligne 1
            cle = FL1.Cells(i, 3).Value & FL1.Cells(1, j).Value
 
'Recherche de la valeur de FL1.Cells(i,3) dans la colonne F de FL2
            With FL2.Range("Y2:Y" & Split(FL2.UsedRange.Address, "$")(4))
                Set c = .Find(FL1.Cells(i, 3).Value)
                If Not c Is Nothing Then
                    LigDeb = c.Address
                    Do
                        k = c.Row
                        CurrString = FL2.Cells(k, 25).Value & FL2.Cells(k, 26).Value
                        If CurrString = cle Then
                            'If CDate(FL2.Cells(k, 22)) = #12/31/2099# Then
                                'Je récupère le type qui est en colonne C
                                Dtype = FL2.Cells(k, 3)
                                With FL1.Cells(i, j).Font
                                    Select Case Dtype
                                    Case "type1"
                                        If CDate(FL2.Cells(k, 22)) = #12/31/2099# Then 'valeur temp
                                            FL1.Cells(i, j).Comment.Delete 'supprime un eventuel commentaire
                                            FL1.Cells(i, j).AddComment "TmpType1 :" & FL2.Cells(k, 18)
                                            FL1.Cells(i, j).Comment.Visible = False
                                        Else
                                            .Bold = True
                                            .ColorIndex = xlAutomatic
                                            FL1.Cells(i, j) = FL2.Cells(k, 18)
                                        End If
                                    Case "type2"
                                        'Ici on met la valeur en commentaire
                                        FL1.Cells(i, j).Comment.Delete 'supprime un eventuel commentaire
                                        FL1.Cells(i, j).AddComment "type2:" & FL2.Cells(k, 18) & FL2.Cells(k, 19)
                                        FL1.Cells(i, j).Comment.Visible = False
                                        .Bold = True
                                        '.ColorIndex = 3
                                    Case "type3"
                                        If CDate(FL2.Cells(k, 22)) = #12/31/2099# Then 'valeur temp
                                            FL1.Cells(i, j).Comment.Delete 'supprime un eventuel commentaire
                                            FL1.Cells(i, j).AddComment "TmpType3 :" & FL2.Cells(k, 18)
                                            FL1.Cells(i, j).Comment.Visible = False
                                        Else
                                            .Bold = False
                                            .ColorIndex = 5
                                            FL1.Cells(i, j) = FL2.Cells(k, 18)
                                        End If
                                    Case Else
                                        .Bold = False
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    End Select
                                End With
                            'Else
                                'If FL2.Cells(k, 3) = "type2" Then FL1.Cells(i, j).Comment.Text = FL1.Cells(i, j).Comment.Text & Chr(10) & "Tmp : " & FL2.Cells(k, 18) & " till " & FL2.Cells(k, 22)
                                'If FL2.Cells(k, 3) = "type1" Then FL1.Cells(i, j).Comment.Text = FL1.Cells(i, j).Comment.Text & Chr(10) & "Tmptype1 : " & FL2.Cells(k, 18) & " till " & FL2.Cells(k, 22)
                                'If FL2.Cells(k, 3) = "type3" Then FL1.Cells(i, j).Comment.Text = FL1.Cells(i, j).Comment.Text & Chr(10) & "Tmptype3 : " & FL2.Cells(k, 18) & " till " & FL2.Cells(k, 22)
                            'End If
                        End If
 
 
'Cette recherche ne se poursuit que si FL1.Cells(i, 1) a été trouvé
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> LigDeb
                End If
            End With
        Next i
'Ajoute une ligne à FL1
        j = j + 1
    Wend
   Application.ScreenUpdating = True
   Set FL1 = Nothing
   Set FL2 = Nothing
End Sub

A++
Qwaz

[azerty1956]

Merci Qwaz mais ton code ne résout pas le problème puisqu'il ne permettra pas de mettre deux commentaires à une même cellule.
Je stocke dans un premier temps les commentaires dans "com" et après je fais une concaténation pour pouvoir en mettre plusieurs à une même cellule,
Voila mon code ( en rouge souligné la partie où ca bug)

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
90
91
92
93
Sub test()

Dim i As Integer, j As Integer, k As Integer
Dim cle As String, CurrString As String
Dim FL1 As Worksheet 'Feuille "sheet3"
Dim FL2 As Worksheet 'Feuille "sheet1"
Dim com As String
Dim c As Range, LigDeb As String
Dim Dtype As String
    Sheets("sheet3").Range("D2:IV356").Select
    Cells.ClearComments
    Selection.ClearContents
   Application.ScreenUpdating = False
'Instanciation des feuilles de calculs concernées (pour simplifier le code à venir)
     Set FL1 = Worksheets("sheet3")
     Set FL2 = Worksheets("sheet1")
    CurrString = ""
    j = 4
    Application.ScreenUpdating = False
    While FL1.Cells(1, j).Value <> ""
       
        For i = 2 To 390
'La clé est constituée de la colonne 3 d'une même ligne & de la colonne J de la ligne 1
            cle = FL1.Cells(i, 3).Value & FL1.Cells(1, j).Value
            
'Recherche de la valeur de FL1.Cells(i,3) dans la colonne F de FL2
            With FL2.Range("Y2:Y" & Split(FL2.UsedRange.Address, "$")(4))
                Set c = .Find(FL1.Cells(i, 3).Value)
                If Not c Is Nothing Then
                    LigDeb = c.Address
                    Do
                        k = c.Row
                        CurrString = FL2.Cells(k, 25).Value & FL2.Cells(k, 26).Value
                        If CurrString = cle Then
                            If CDate(FL2.Cells(k, 22)) = #12/31/2099# Then
                                'Je récupère le type qui est en colonne C
                                Dtype = FL2.Cells(k, 3)
                                With FL1.Cells(i, j).Font
                                    Select Case Dtype
                                    Case "type3"
                                        .Bold = True
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    Case "type2"
                                     
                                        com = "type2:" & FL2.Cells(k, 18) & FL2.Cells(k, 19)
                                        .Bold = True
        
                                    Case "type1"
                                        .Bold = False
                                        .ColorIndex = 5
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    Case Else
                                        .Bold = False
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
                                    End Select
                                End With
                            Else
                                If FL2.Cells(k, 3) = "type2" Then
                                com = com & Chr(10) & "Tmp2 : " & FL2.Cells(k, 18) & "" & "till" & "" & FL2.Cells(k, 22)
                                
                                End If
                                If FL2.Cells(k, 3) = "type3" Then
                            
                                 com = com & Chr(10) & "Tmp3 : " & FL2.Cells(k, 18) & "" & "till" & "" & FL2.Cells(k, 22)
                                
                                End If
                                If FL2.Cells(k, 3) = "type1" Then
                                 com = com & Chr(10) & "Tmp1 : " & FL2.Cells(k, 18) & "" & "till" & "" & FL2.Cells(k, 22)
                                
                                End If
                            End If
                            If (com <> "") Then
                            'Ici on met la valeur en commentaire
                            FL1.Cells(i, j).AddComment
                            FL1.Cells(i, j).Comment.Visible = False
                            FL1.Cells(i, j).Comment.Text Text:="commentaire :" & com
                            End If
                        End If


'Cette recherche ne se poursuit que si FL1.Cells(i, 1) a été trouvé
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> LigDeb
                End If
            End With
        Next i
'Ajoute une ligne à FL1
        j = j + 1
    Wend
   Application.ScreenUpdating = True
End Sub

Je te remercie d'avance

[Qwazerty]

Salut
Si ça bug sur cette ligne, c'est certainement par ce qu'un commentaire existe deja, supprime un commentaire éventuel avant de mettre le tiens

FL1.Cells(i, j).Comment.Delete 'supprime un éventuel commentaire

Je n'est pas repris ton code, mais si tu souhaite rajouter au commentaire existant, après avoir vérifié si un commentaire existe, il suffit de travailler avec comment.Text directement

a++
Qwaz

[wilfried_42]

Bonjour à tous

la destruction d'un commentaire qui n'existe pas provoque une erreur et pour éviter le on error resume next qui peut provoquer plus de mal que de bien :

Code :

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

1
2
3
Dim Cmt as Comment
set Cmt = FL1.Cells(i, j).Comment
if not Cmt is Nothing then Cmt.delete

[azerty1956]

merci wilfried_42 pour ton intervention
mais ca ne résout pas mon problème car dans certain cas je dois avoir dans mon tableau deux commentaires affectés à une seule cellule....
Donc je ne souhaite pas effacer les commentaires qui ont été inséré dans mon tableau avec la boucle précédente....

[wilfried_42]

re:

tu n'as cas effacer les commentaires avant la boucle et les recréer tout simplement. comme cela avec la même methode, set cmt = .........
if not c is nothing then
' Modification du commentaire avec ajout du message supplémentaire
else
' Création du commentaire
end if

[azerty1956]

J'ai fait ça mais je ne sais pas pourquoi ca ne marche pas.
Je suis débutant en VBA et il se peut que j'ai fait des fautes aberrantes dans mon code.

comment je peux insérer ca dans mon code de facon à ne pas avoir de bug?

merci d'avance

[azerty1956]

J'ai toujours un bug au niveau du Add.comment, j'ai tout essayé mais ca ne marche pas....quand je supprime les commentaires ca marche mais ca ne m'insère pas plusieurs commentaires dans la cellule...Mon problème réside dans le fait que je veux insérer 2 commentaires dans la cellule....
Je comprends pas non plus pourquoi mon com ( la ou je fais la concaténation des commentaires) est vide quand je lance ma macro??

[wilfried_42]

re:

je précise ma pensée

Code :

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

1
2
3
4
5
6
7
8
9
10
11
' en début de macro
Dim cmt as comment
For each cmt in Fl1.comments
     cmt.delete
next
' ta macro 
' là où tu insères tes commentaire
set cmt = FL1.Cells(i, j).comments
if cmt is nothing then FL1.cells(i,j).addcomment ' crée un commentaire vide
' Ensuite tu ajoutes ton commentaire en modification de commentaire
' Comme cela si tu en as un deuxieme, il s'ajoutera automatiquement

[azerty1956]

Merci wilfried_42 pour ta réponse
Mais justement c'est à ce niveau que je sais pas comment faire :

' Ensuite tu ajoutes ton commentaire en modification de commentaire
' Comme cela si tu en as un deuxieme, il s'ajoutera automatiquement

ci-dessous mon code il marche pas du tout....????

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
90
91
92
93
94
95
96
 
Sub test22()
 
Dim i As Integer, j As Integer, k As Integer
Dim cle As String, CurrString As String
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim com As Comment
Dim c As Range, LigDeb As String
Dim Dtype As String
 
   Application.ScreenUpdating = False
'Instanciation des feuilles de calculs concernées (pour simplifier le code à venir)
     Set FL1 = Worksheets("sheet2")
     Set FL2 = Worksheets("sheet1")
    FL1.Activate
    FL1.Range("E3:IV356").Select
    Cells.ClearComments
    Selection.ClearContents
 
    CurrString = ""
    j = 5
    Application.ScreenUpdating = False
    While FL1.Cells(1, j).Value <> ""
 
        For i = 3 To 390
'La clé est constituée de la colonne 3 d'une même ligne & de la colonne J de la ligne 1
            cle = FL1.Cells(i, 4).Value & FL1.Cells(2, j).Value
 
'Recherche de la valeur de FL1.Cells(i,3) dans la colonne F de FL2
            With FL2.Range("Y2:Y" & Split(FL2.UsedRange.Address, "$")(4))
                Set c = .Find(FL1.Cells(i, 4).Value)
                If Not c Is Nothing Then
                    LigDeb = c.Address
                    Do
                        k = c.Row
                        CurrString = FL2.Cells(k, 25).Value & FL2.Cells(k, 26).Value
                        If CurrString = cle Then
                            If CDate(FL2.Cells(k, 22)) = #12/31/2099# Then
                                'Je récupère le type qui est en colonne C
                                Dtype = FL2.Cells(k, 3)
                                With FL1.Cells(i, j).Font
                                    Select Case Dtype
                                    Case "type1"
                                        .Bold = True
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
 
                                   Case "type2"
                                        .Bold = False
                                        .ColorIndex = 5
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
 
                                    Case "type3"
                                       For Each com In FL1.Comments
                                        com.Delete
                                        Next
                                         Set com = FL1.Cells(i, j).Comment
                                        com = "type3:" & FL2.Cells(k, 18) & FL2.Cells(k, 19)
                                        .Bold = True
 
                                        If Not com Is Nothing Then com.Delete
                                    End Select
                                End With
                            Else
                                If FL2.Cells(k, 3) = "type3" Then
                                com = com & Chr(10) & "Tmp3 : " & FL2.Cells(k, 18) & "" & "till" & "" & FL2.Cells(k, 22)
                                End If
                                If FL2.Cells(k, 3) = "type1" Then
                                com = com & Chr(10) & "Tmp1 : " & FL2.Cells(k, 18) & "" & "till" & "" & FL2.Cells(k, 22)
                                End If
 
                                If FL2.Cells(k, 3) = "type2" Then
                                com = com & Chr(10) & "Tmp2 : " & FL2.Cells(k, 18) & "" & "till" & "" & FL2.Cells(k, 22)
                                End If
                            End If
                            If com Is Nothing Then FL1.Cells(i, j).AddComment
                            FL1.Cells(i, j).com.Text Text:="commentaire :" & com
                            End If
 
 
'Cette recherche ne se poursuit que si FL1.Cells(i, 1) a été trouvé
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> LigDeb
                End If
            End With
        Next i
'Ajoute une ligne à FL1
        j = j + 1
    Wend
   Application.ScreenUpdating = True
   Set com = Nothing
   Set FL1 = Nothing
   Set FL2 = Nothing
   Set c = Nothing
End Sub

[wilfried_42]

re:

le mieux serait que tu fournisses le fichier avec des exemple de ce que tu cherches . mais je peux penser que tu mélanges et le commentaire en lui même et l'objet commentaire

j'ai fait des modifs en fonction de ce que j'ai compris, la structure doit maintenant être correcte mais ce n'est pas forcement encore ce que tu désires.
voici ta macro modifiée

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
90
91
92
93
Sub test22()
 
Dim i As Integer, j As Integer, k As Integer
Dim cle As String, CurrString As String
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim com As String, cmt As Comment
Dim c As Range, LigDeb As String
Dim Dtype As String
 
   Application.ScreenUpdating = False
'Instanciation des feuilles de calculs concernées (pour simplifier le code à venir)
     Set FL1 = Worksheets("sheet2")
     Set FL2 = Worksheets("sheet1")
    FL1.Activate
    FL1.Range("E3:IV356").Select
    Cells.ClearComments
    Selection.ClearContents
 
    CurrString = ""
    j = 5
    Application.ScreenUpdating = False
    While FL1.Cells(1, j).Value <> ""
 
        For i = 3 To 390
'La clé est constituée de la colonne 3 d'une même ligne & de la colonne J de la ligne 1
            cle = FL1.Cells(i, 4).Value & FL1.Cells(2, j).Value
 
'Recherche de la valeur de FL1.Cells(i,3) dans la colonne F de FL2
            With FL2.Range("Y2:Y" & Split(FL2.UsedRange.Address, "$")(4))
                Set c = .Find(FL1.Cells(i, 4).Value)
                If Not c Is Nothing Then
                    LigDeb = c.Address
                    Do
                        k = c.Row
                        CurrString = FL2.Cells(k, 25).Value & FL2.Cells(k, 26).Value
                        If CurrString = cle Then
                            If CDate(FL2.Cells(k, 22)) = #12/31/2099# Then
                                'Je récupère le type qui est en colonne C
                                Dtype = FL2.Cells(k, 3)
                                With FL1.Cells(i, j).Font
                                    Select Case Dtype
                                    Case "type1"
                                        .Bold = True
                                        .ColorIndex = xlAutomatic
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
 
                                   Case "type2"
                                        .Bold = False
                                        .ColorIndex = 5
                                        FL1.Cells(i, j) = FL2.Cells(k, 18)
 
                                    Case "type3"
                                        com = "type3:" & FL2.Cells(k, 18) & FL2.Cells(k, 19)
                                    End Select
                                End With
                            Else
                                If FL2.Cells(k, 3) = "type3" Then
                                    com = "Tmp3 : " & FL2.Cells(k, 18) & "" & "till" & "" & FL2.Cells(k, 22)
                                End If
                                If FL2.Cells(k, 3) = "type1" Then
                                    com = "Tmp1 : " & FL2.Cells(k, 18) & "" & "till" & "" & FL2.Cells(k, 22)
                                End If
                                If FL2.Cells(k, 3) = "type2" Then
                                    com = "Tmp2 : " & FL2.Cells(k, 18) & "" & "till" & "" & FL2.Cells(k, 22)
                                End If
                            End If
                            Set cmt = FL1.Cells(i, j).Comments
                            If cmt Is Nothing Then
                                With FL1.Cells(i, j).AddComment
                                     .Text Text:="Commentaires : "
                                End With
                                Set cmt = FL1.Cells(i, j).Comments
                            End If
                            cmt.Text Text:=cmt.Text & vbCrLf & com
                            End If
 
 
'Cette recherche ne se poursuit que si FL1.Cells(i, 1) a été trouvé
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> LigDeb
                End If
            End With
        Next i
'Ajoute une ligne à FL1
        j = j + 1
    Wend
   Application.ScreenUpdating = True
   Set cmt = Nothing
   Set FL1 = Nothing
   Set FL2 = Nothing
   Set c = Nothing
End Sub