aide macro excel

[swordjet19]

Bonjour à tous,

Voila, j'ai un fichier dans lequel il y a une liste de film. Je souhaite faire une macro qui extrait les films par "Genre" (onglet 'listefilms"), dans un tableau (onglet 'synthesefilm') dans lequel il récupère le titre, le réal, et l'année seulement.

Je ne sais pas du tout comment faire....

Merci par avance de votre aide.
😱

 

[swordjet19]

Re : aide macro excel

😱 oups, j ai oublie la piece jointe

 

[Gorfael]

Re : aide macro excel

😱 oups, j ai oublie la piece jointe

Salut au forum

Sub Test()
Dim F_S As Worksheet
Dim F_D As Worksheet
Dim Lig_S As Long
Dim Lig_D As Long
Dim Lig_T As Long

Dim X As Integer
Dim Tab_Genre() As String
Dim Flg_Test As Boolean

'MEI ******************************************
'Feuille source
Set F_S = Sheets("listefilms")
'Feuille destination
Set F_D = Sheets("synthesefilm")
'On redimensionne le tableau de stockage des genre
ReDim Tab_Genre(0)

'Recherche des genres

'de la ligne 2 à la dernière de C
For Lig_S = 2 To F_S.Range("A65536").End(xlUp).Row
    'Flg_Test = Vrai
    Flg_Test = True
    'de X = 1 au dernier indice du tableau
    For X = 1 To UBound(Tab_Genre)
        'si valeur cellule A ligne Lig_S ( =Tab_genre(x) ou vide) alors
        If (Tab_Genre(X) = F_S.Range("A" & Lig_S)) Or IsEmpty(F_S.Range("A" & Lig_S)) Then
            'Flg_Test = Faux
            Flg_Test = False
            'on sort de la boucle X
            Exit For
        End If
    Next X 'Pour aller au X suivant
    ' Flg_Test = Vrai alors
    If Flg_Test Then
        'on redimensionne le tableau (dernier indice = dernier indice+1, en conservant les données
        ReDim Preserve Tab_Genre(0 To UBound(Tab_Genre, 1) + 1)
        'Tab_genre(dernier indice)=valeur colonne A ligne Lig_S
        Tab_Genre(UBound(Tab_Genre, 1)) = F_S.Range("A" & Lig_S)
    End If
Next Lig_S

'on un tableau avec tout les genres

'copie ************************************************************
'effacement ancien
F_D.Rows("1:" & Cells.SpecialCells(xlCellTypeLastCell).Row).Delete
Lig_D = 1
For X = 1 To UBound(Tab_Genre, 1)
    'création en-tête
    F_D.Range("A" & Lig_D) = Tab_Genre(X)
    F_D.Range("A" & Lig_D & ":C" & Lig_D).Merge
    'on passe à la ligne suivante
    Lig_D = Lig_D + 1
    
    F_D.Range("A" & Lig_D) = "Titre"
    F_D.Range("B" & Lig_D) = "Réalisateur"
    F_D.Range("C" & Lig_D) = "Année"
    Lig_D = Lig_D + 1
    
    'mise en forme
    With F_D.Range("A" & Lig_D - 2 & ":C" & Lig_D - 1)
        .HorizontalAlignment = xlCenter
        
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
        
        .Font.Bold = True
    End With
    
    F_D.Range("A" & Lig_D - 2).Font.ColorIndex = 3
    
    'début des films
    Lig_T = Lig_D
    'recherche et copie
    For Lig_S = 1 To F_S.Range("A65536").End(xlUp).Row
        'si on trouve le bon genre
        If F_S.Range("A" & Lig_S) = Tab_Genre(X) Then
            'on copie
            F_D.Range("A" & Lig_D) = F_S.Range("B" & Lig_S)
            F_D.Range("B" & Lig_D) = F_S.Range("C" & Lig_S)
            F_D.Range("C" & Lig_D) = F_S.Range("E" & Lig_S)
            Lig_D = Lig_D + 1
        End If
    Next Lig_S
    
    'Mise en forme
    With F_D.Range("A" & Lig_T & ":C" & Lig_D - 1)
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
    End With
    'on saute une ligne
    Lig_D = Lig_D + 1
Next X

End Sub

Menu Outils>>Macro>>nouvelle macro>>ok
Dans la barre d'outils qui apparaît Arrêter la macro

Menu Outils>>Macro>>Macros
Tu sélectionnes la macro => Modifier
Tu te retrouves sur une page avec le nom de la macro que tu viens de créer
Tu peux la supprimer (de Sub à End Sub

Le but étant de créer un Module (que tu peux voir dans l'arborescence à gauche)
tu copies le code ci-dessus dans la macro (copier/coller marche très bien)

Tu viens de créer ta macro. Tu peux retourner sur Excel
Menu Outils>>macro>>Macros => tu sélectionnes Test et tu l'exécutes

Si tu veux savoir ce qui se passes, tu l'exécute en Pas-à-pas, quand tu es sur VBE, la touche F8 fait exécuter la ligne surlignée en jaune et surligne la prochaine qu'il va exécuter

Si problème, pose tes questions, on tachera d'y répondre

A+

 

[swordjet19]

Re : aide macro excel

Merci beaucoup pr ton aide, ca marche super!!

Je le réessaierai au boulot lundi, sur un autre fichier, mais c génial!

Merci encore....

Bon Week end!