planning et recapt

[patrick7676]

bonjour j'espère que vous avez pas un bon weekend

voila mon petit problème
j'ai un fichier avec deux onglets . il s'appelle " Planning et Recapt "

Dans le fichier " planning " les élèves sont inscrit dans les matières en fonction des jours . l'inscription est symbolisé par une croix ( fond jaune )

Je souhaiterai que dans le fichier "Recapt" : A chaque jour nous trouvons les noms des élèves dans chaque matière

Pour être plus clair je vous ai mis un fichier joint

merci

 

[patrick7676]

Re : planning et recapt

personne pour me donner une piste pour m'aider

 

[gosselien]

Re : planning et recapt

Oui ...


essaye ceci...

P.

 

[patrick7676]

Re : planning et recapt

ok c'et en VBA
peut tu me donner quelques explications ?

Peut on le faire avec des formules ?

merci pour ton aide

 

[gosselien]

Re : planning et recapt

Bonjour,

pour les formules, il faudra demander aux experts; j'ai un niveau moyen en formule et vba moi...

j'ai commenté le code:


P.


Option Base 1 ' pour démarrer une recherche à 1 dans une array
Sub Tableau()
Dim Mat2 As Integer
Set WS1 = Sheets("planning") ' WS1 est plus court pour retrouver la feuille
Set Ws2 = Sheets("récapt")
Ws2.Range("A4:A40").ClearContents
Dim Choix() 'ARRAY
Choix = Array("Histoire", "Géographie", "Maths", "Français", "Anglais", "Lecture")
' je mets dans une array mes différentes matières
Ligne = 4 ' la 1ere ligne en Récap est 4
Dim mdate2 'mémoriser une date
Dim Diff As Integer ' différence entre la date mémorisée et la dte qui correspond à la cellule en cours
Dim mNom2 As String
mdate = WS1.Range("B4").Value ' je mémorise la date en B4 feuille planning
For Each C In Range("table") ' j'ai nommé TABLE la zone de planning (avec les couleurs)
' boucle sur chaque contenu de cette zone
mrow = C.Row ' ligne actuelle (qui va changer dans la boucle)
Mcol = C.Column ' colonne actuelle (qui va changer dans la boucle )
If Not C = "" And UCase(C.Value) = UCase("x") Then ' si pas vide et si "X" ds la cellule
mat = WS1.Cells(5, C.Column).Value ' memoriser la matière
mnom = WS1.Cells(mrow, 1).Value ' mémo du nom
Diff = WS1.Cells(4, C.Column).Value - mdate
If Diff <> 0 Then ' si la date départ <> de la cellule actuelle
Ligne = Ligne ' on garde la ligne de départ
Else 'sinon
Ligne = 4 'on revient à la ligne du début (4)
End If
If Not IsError(Application.Match(mat, Choix, 0)) Then
' si on trouve la matière en position 5 dans
' l'array "choix" , on en mémorise sa position avec mat2
' "lecture" est le 6e dans l'Array donc on mets le résultat
' dans la colonne 1 (col A de récap) + numéro de la position 6 = 7e colonne à l'arrivée
Mat2 = Application.Match(mat, Choix, 0) '
Ws2.Cells(Ligne + Diff, 1).Value = mdate + Diff
' la ligne d'arrivée est soit 4 (feuille récup) soit 4 + la différence trouvée plus haut
Ws2.Cells(Ligne + Diff, Mat2 + 1).Value = mnom 'sur cette ligne on y colle la matière mémorisée
End If
End If
Next
End Sub

' ceci est MON approche, il y a surement mieux et ça fige un peu les 2 feuilles, dans le
' sens où elles ne peuvent pas être déplacées, en tout cas pas l'arrivée
' d'autres ici feront certainement mieux

 

[patrick7676]

Re : planning et recapt

merci beaucoup mais je pense que cela vaêtre compliqué pour l(adapter pour mon problème .
Jespère qu'il y aura quelqu'un pour m'aider à travailler avec des formules . cela sera plus simple pour moi

a tout de suite

merci

 

[patrick7676]

Re : planning et recapt

une petite aide ou une petite piste pour m'aider aujordhui

merci

 

[gosselien]

Re : planning et recapt

une petite aide ou une petite piste pour m'aider aujordhui

merci

heuu c'est une question ? ou .... tu ne veux pas expliquer , ou c'est un simple merci, si oui, merci du retour

 

[patrick7676]

Re : planning et recapt

déjà merci pour le travail que tu as accompli . mais c'est vrai en décortiquant la VBA, que tu as faite , je ne pourrais pas la retranscrire dans un autre fichier . c'est pour cela que l'utilisation de formules ou de matrices sera plus simple pour moi .

C'est pour cela que je cherche un début de piste pour maider

merci

 

[gosselien]

Re : planning et recapt

Ok, pas de soucis...

Je te conseille néanmoins vivement de ne PAS utiliser des cellules fusionnées, ça fout souvent la m...

Je suivrai le fil pour les formules

P.

 

[patrick7676]

Re : planning et recapt

tu peux suivre le fil cependant à part toi je n'ai pas d'aide ou de début de piste

allez messieurs ou mesdames , pouvez vous m'aider

merci

 

[klin89]

Re : planning et recapt

Bonsoir patrick7676, gosselien, le forum

A tester :

Option Explicit
Sub Reorganise()
Dim a, b(), i As Long, j As Long, k As Long, n As Long
    Application.ScreenUpdating = False
    a = Sheets("planning").Range("B4").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 7)
    For i = 2 To UBound(a, 2)
        If (i - 2) Mod 6 = 0 Then
            k = 2: n = n + 1
            b(n, 1) = a(1, i)
        End If
        For j = 3 To UBound(a, 1)
            If a(j, i) <> "" Then
                b(n, k) = a(j, 1)
                Exit For
            End If
        Next
        k = k + 1
    Next
    'Restitution et mise en forme
    With Sheets("récapt").Cells(1).Resize(, 7)
        .CurrentRegion.Clear
        .Value = Array("", "histoire", "géographie", "maths", "français", "anglais", "lecture")
        With .Offset(1).Resize(n)
            .Value = b
            With .CurrentRegion
                .BorderAround ColorIndex:=1, Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Font.Name = "calibri"
                .Font.Size = 10
                With .Rows(1)
                    .Font.Size = 11
                    .RowHeight = 18
                    .BorderAround ColorIndex:=1, Weight:=xlThin
                    With .Offset(, 1).Resize(, .Columns.Count - 1)
                        .Interior.ColorIndex = 44
                    End With
                End With
                With .Columns(1)
                    With .Offset(1).Resize(.Rows.Count - 1)
                        .Interior.ColorIndex = 43
                    End With
                End With
                .Parent.Activate
            End With
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[patrick7676]

Re : planning et recapt

bonjour c'est très gentil klin89 pour le travail accompli malheureusement je suis nul en VBA .

Y a t il possibilité de faire ce travail avec formules ?

en attente d'une réponse de ta part et bien sur de tout le monde .

Et si oui peut on me donner un bout de piste pour commencer ?

 

[patrick7676]

Re : planning et recapt

une petite aide avec des formules svp

merci

 

[pascal21]

Re : planning et recapt

bonjour a tous
dommage que tu ne sache pas adapter le code proposé par KLIN89, car il fonctionne très bien et à l'air dans le sens de ce que tu cherches à avoir
dis nous simplement les différences entre le fichier exemple et ton fichier réel ( plages de cellules)
on devrait arriver à adapter par la suite