Mise en forme d'une page en VBA

Version imprimable

24/10/2011, 21h11
Naru80

1 pièce(s) jointe(s)

Mise en forme d'une page en VBA

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.
24/10/2011, 21h36
mercatog

Bonsoir
Et comment différencier entre conseiller et autre?
24/10/2011, 21h57
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

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

24/10/2011, 22h17
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

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

24/10/2011, 22h43
Naru80

En effet fonctionne également très bien

encore et toujours merci :)