[XL-2003] Mise en forme d'une page en VBA [Résolu]

[Naru80]

Bonjour,

J'ai un petit souci dans une présentation de Excel.

J'ai besoin de faire un tableau qui récapitule des données mais mon fichier sources n'est pas en forme comme je le souhaite.

Il faudrait refaire la mise en page du fichier de base et c'est la que je bloque

Je vous ai mis le fichier en pièce jointe avec une feuille pour le fichier de base et une seconde feuille avec le fichier comme j'aimerai qu'il apparaisse une fois la macro exécuté. Je vous ai mis un petit listing mais j'ai environ 5.000 lignes dans le fichier complet.

Il doit falloir utiliser des boucles pour chercher le nom du conseiller et voir toute les formations en dessous et le score mais je bloque je suis pas très bon avec les boucles.

Si vous avez besoin de plus de renseignement n’hésite pas à me le demander.

Merci d'avance pour votre aide.

[mercatog]

Bonsoir
Et comment différencier entre conseiller et autre?

[Naru80]

Si tu veux dans le fichier j'ai le nom du conseiller qui est toujours Fusionner de A à H

En dessous j'ai différents nom de formations en A et la note en F
Mais voila il peut avoir plusieurs formation pour un même conseiller
et parfois je peux avoir plusieurs fois le même nom de formation en dessous mais juste une fois la note

La seule chose qui peut aider je pense c'est qu'il y a toujours une ligne vide avant de reprendre un nouveau conseiller

Avec la pièce jointe c'est plus parlant mais elle est en cours de validation

[mercatog]

Ci joint proposition à adapter au niveau du nom de la feuille de destination (cf. commentaire)

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
Sub TEST()
Dim LastLig As Long, i As Long, j As Long
Dim Conseil As String
Dim Sh As Worksheet
 
Application.ScreenUpdating = False
Set Sh = Worksheets("Feuil1")                              ' feuille de destination  à adapter
Sh.Range("A1:C1") = Array("Nom du conseiller", "Nom de la formation", "Score")
j = 2
With Worksheets("Fichier de base")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To LastLig
        If .Range("B" & i) Like "Effectuée" Then
            Conseil = .Range("A" & i - 1)
        ElseIf .Range("B" & i) Like "Score" Then
            Sh.Range("A" & j) = Conseil
            Sh.Range("B" & j) = .Range("A" & i - 1)
            Sh.Range("C" & j) = .Range("B" & i + 1)
            j = j + 1
        End If
    Next i
End With
Set Sh = Nothing
End Sub

[Naru80]

je viens de tester et je n'ai qu'une chose à dire

MERCI

Cela fonctionne nickel et en plus c'est super rapide.
Je viens souvent sur ce forum pour chercher de l'aide dans les différents message posté et la je me suis dis après 3heures de test arrête un peu et demande enfin de l'aide. encore merci

[mercatog]

En utilisant une variable tableau c'est encore plus rapide

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
Sub TEST()
Dim LastLig As Long, i As Long, j As Long
Dim Conseil As String
Dim Sh As Worksheet
Dim Tb, Res()
 
Application.ScreenUpdating = False
Set Sh = Worksheets("Feuil1")                              ' feuille de destination  à adapter
Sh.UsedRange.Clear
ReDim Res(1 To 3, 1 To 1)
Res(1, 1) = "Nom conseiller": Res(2, 1) = "Nom formation": Res(3, 1) = "Score": j = 1
With Worksheets("Fichier de base")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Tb = .Range("A1:B" & LastLig)
    For i = 1 To LastLig
        If Tb(i, 2) Like "Effectuée" Then
            Conseil = Tb(i - 1, 1)
        ElseIf Tb(i, 2) Like "Score" Then
            j = j + 1
            ReDim Preserve Res(1 To 3, 1 To j)
            Res(1, j) = Conseil
            Res(2, j) = Tb(i - 1, 1)
            Res(3, j) = Tb(i + 1, 2)
        End If
    Next i
End With
If j > 1 Then Sh.Range("A1").Resize(j, 3) = Application.Transpose(Res)
Set Sh = Nothing
End Sub

[Naru80]

En effet fonctionne également très bien

encore et toujours merci