fusionner emploi du temps

[bilboibiloba]

Bonjour à vous tous,
Je rencontre un problème alors que je souhaiterai améliorer un fichier qui me prends du temps à remplir.Dans une feuille (EDT) j'ai l'emploi du temps des jeunes ainsi que l'activité qu'ils suivent et le nom de l'encadrant à coté ,ceci dans des colonnes distinct. Je souhaiterai dans ma feuille edtfusionner mettre toutes les info en une seule colonne. Pouvez vous m'aider à créer ce fichier ou plutôt comment je dois procéder par étape pour arriver au résultat souhaité.
merci pour votre aide

 

[PMO2]

Re : fusionner emploi du temps

Bonjour,

Une piste mais en VBA.
Je me suis référé entièrement à votre feuille "EDT" et il est impératif d'en conserver la structure. Vous pouvez néanmoins ajouter des paires de colonnes Activité/Professeur pour le nombre d'élèves que vous voulez.

Copiez le code suivant dans un module standard

Const NOM_FEUILLE_FUSION As String = "EDT FUSIONNER"

Sub FusionnerEDT()
Dim S As Worksheet
Dim R As Range
Dim var
Dim i&
Dim j&
Dim deb&
Dim fin&
Dim nbCol&
Dim A$
Dim Hdeb As Date
Dim Hfin As Date
Set S = Sheets("EDT")
Set R = S.Range(S.Cells(1, 1), S.Cells(S.[a2].End(xlDown).Row, S.[c1].End(xlToRight).Column))
nbCol& = R.Columns.Count
R.Copy
Set S = Sheets.Add
On Error Resume Next
Do
  Err.Clear
  i& = i& + 1
  S.Name = NOM_FEUILLE_FUSION & Space(1) & i&
Loop Until Err = 0
On Error GoTo Erreur
Application.ScreenUpdating = False
With S.[a1]
  .PasteSpecial Paste:=xlPasteFormats
  .PasteSpecial Paste:=xlPasteValues
End With
Set R = S.Range(S.Cells(1, 1), S.Cells(S.[a2].End(xlDown).Row + 1, S.[a21].End(xlToRight).Column))
var = R
For j& = 3 To UBound(var, 2) Step 2
  deb& = 2
  For i& = 2 To UBound(var, 1) - 1
      If var(i&, j&) <> var(i& + 1, j&) Then
        Set R = S.Range(S.Cells(deb&, j&), S.Cells(i&, j&))
        R.ClearContents
        R.MergeCells = True
        R.HorizontalAlignment = xlCenter
        R.VerticalAlignment = xlCenter
        R.WrapText = True
        '--- Construction de la chaîne ---
        A$ = var(i&, j&) & Chr(10)
        A$ = A$ & var(i&, j& + 1) & Chr(10)
            '°°° Heure de début et heure de fin °°°
        Hdeb = CDate(S.Range(S.Cells(deb&, 2), S.Cells(deb&, 2)))
        Hfin = CDate(S.Range(S.Cells(i&, 2), S.Cells(i&, 2)))
        A$ = A$ & "de " & Format(Hdeb, "hh:mm") & " à " & Format(Hfin, "hh:mm") & Chr(10)
        A$ = A$ & "soit " & Format(Hfin - Hdeb, "hh:mm")
            '°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
        R = A$
        deb& = i& + 1
      End If
  Next i&
Next j&
For i& = nbCol& To 3 Step -2
  S.Columns(i&).Delete Shift:=xlToLeft
Next i&
S.[a1].Select
Erreur:
Application.ScreenUpdating = True
End Sub

Il n'y a plus qu'à lancer la macro FusionnerEDT

Cordialement.

PMO
Patrick Morange

 

[bilboibiloba]

Re : fusionner emploi du temps

Bonjour PMO2
C'est super cela marche parfaitement mais le plus dure pour moi reste à faire c'est comprendre.Comment puis-je procéder pour faire un code vba comme celui-ci étape par étape.Je vous remercie de votre aide très précieuse.Cordialement .bilboibiloba