Discussion :

[mouncefdi]

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 les noms 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 avoir les valeurs prises de la colonne R de la sheet 1 avec des couleurs différentes selon leurs types ( types 1,2 ou 3 présents sur la colonne C de la sheet 1).

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

En effet, si vous regarder de plus près un bout de mon tableau ci-joint vous verrez que pour une seule cellule dans la sheet 3 je peux avoir plusieurs valeurs (prises de la colonne R de la sheet 1) de types différents (types définis dans la colonne C de la sheet 1). C’est pour cette raison que je souhaite prendre en compte le type en instaurant un code couleur pour les valeurs. Comme ça je pourrais avoir dans une même cellule 3 les valeurs avec des couleurs différentes correspondant à des types différents.

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

Merci d’avance.

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
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
   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, 5).Value & FL2.Cells(k, 6).Value & FL2.Cells(k, 7).Value & FL2.Cells(k, 8).Value & FL2.Cells(k, 9).Value & FL2.Cells(k, 10).Value & FL2.Cells(k, 11).Value & FL2.Cells(k, 12).Value & FL2.Cells(k, 13).Value & FL2.Cells(k, 14).Value & FL2.Cells(k, 15).Value & FL2.Cells(k, 16).Value & FL2.Cells(k, 17).Value
                        If CurrString = cle Then FL1.Cells(i, j) = FL2.Cells(k, 18)
'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: code couleurs : type1 noir en gras, type2 rouge, type3 en bleu

[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 les noms 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.

Dans le code pour chaque types (types1,2 ou 3, sur la colonne C sheet1) de valeurs prises de la colonne R de la sheet 1 on a une couleurs précise.

En effet, si vous regarder de plus près un bout de mon tableau ci-joint vous verrez que pour une seule cellule dans la sheet 3 je peux avoir plusieurs valeurs (prises de la colonne R de la sheet 1) de types différents (types définis dans la colonne C de la sheet 1). Voir ligne 2,5 et 6 de la sheet 1 où il y a que le type qui change.

Le problème avec mon code est qu’il ne m’affiche que 200 dans la cellule D3 sheet3 au lieu de m’afficher les 3 valeurs : 200,300,57.

J’ai utiliser l’enregistreur des macros ça me donne le code suivant :

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
Sub Macro1()
 
 
    ActiveCell.FormulaR1C1 = "23" & Chr(10) & "24" & Chr(10) & "58"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 3
    End With
    Range("G14").Select
End Sub

Comment je peux incorporer ça dans mon code ???

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
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, 5).Value & FL2.Cells(k, 6).Value & FL2.Cells(k, 7).Value & FL2.Cells(k, 8).Value & FL2.Cells(k, 9).Value & FL2.Cells(k, 10).Value & FL2.Cells(k, 11).Value & FL2.Cells(k, 12).Value & FL2.Cells(k, 13).Value & FL2.Cells(k, 14).Value & FL2.Cells(k, 15).Value & FL2.Cells(k, 16).Value & FL2.Cells(k, 17).Value
                        If CurrString = cle Then 
                           FL1.Cells(i, j) = FL2.Cells(k, 18)
                          '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 "1" 
                               .Bold = True
                               .ColorIndex = xlAutomatic
                           case "2"
                               .Bold = False
                               .Colorindex = 3
                           case "3"
                               .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

NB: je suis vraiment débutant, ce code a été fait par une autre personne et je souhaitrais l'améliorer