Déplacer des cellules sous conditions dans une sélection

M

michel.dupont

XLDnaute Occasionnel
Bonjour
A partir d'un tableau reprenant les congés d'un groupe de personnes j'aimerai pour chacun d'elle en sélectionnant manuellement les lignes et colonnes qui les concernent déplacer les cellules comprenant non vides vers la première ligne correspondant à leur nom.Pouvez-vous m'aider en me suggérant une macro...
avec mes remerciements.
pour une bonne compréhension j'ajoute une petit fichier...
 

Pièces jointes

  • congesst.2xlsm.xlsm
    50.6 KB · Affichages: 29
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Bonjour michel.dupont,

Ce problème est un FAUX problème puisque les "X" sont déterminés par des formules en fonction des dates en colonnes B et C.

Si par exemple on remplace les dates en B5:C5 par celles qui sont en B7:C7 les "X" de F7:I7 "remontent" en F5:I5, mais les autres "X" qui se trouvaient en ligne 5 n'y seront plus...

A+
 
Vote positif 0 Vote négatif
N

Noel Bedard

XLDnaute Occasionnel
Bonsoir à tous,

C'est le genre de requête que j'aime bien. Cela ne répondra probablement pas à vos attentent, mais peut certainement vous donner des idées.

Je me suis amusé avec les mises en formes conditionnelles et pour référence votre feuille, j'ai fait deux calendriers.

Le premier du haut de la page se sert uniquement des MFC, Dans la case D2 vous sélectionnez le Nom (A,B,C,D pour notre exemple) pas de formules dans aucune cellules, seulement une couleur pour chaque Nom.
J'ai placer des filtres pour faire des tris, uniquement pour voir les couleurs se déplacées dans le tableau ;)

Le deuxième un peu plus bas, j'ai gardé vos formules mais j'ai remplacé "X" par le Nom "A24". Et la cellule D24 pour sélection.

J'ai nommés des cellules: Nom, Du, Au, ce sont vos trois colonnes, que j'ai utilisés dans les formules de MFC.

Si cela peut vous servir dans votre feuille.

Noël
 

Pièces jointes

  • Sélection dun employé sur Calendrier.xlsx
    26 KB · Affichages: 17
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re, bonsoir Noel Bedard,
job75 à dit:
Ce problème est un FAUX problème
Cliquez pour agrandir...
Oui avec les formules en place, mais si on les modifie le problème devient cohérent.

Voyez le fichier joint et cette nouvelle formule en E2 à copier et coller sur E2:CP14 :
Code: 
=REPT("X";SIGNE(SOMMEPROD(($A2<>DECALER($A2;-1;))*(E$1>=DECALER($B2;;;NB.SI($A:$A;$A2)))*(E$1<=DECALER($C2;;;NB.SI($A:$A;$A2))))))
Le tableau A2:C14 doit être trié sur la colonne A.

Bonne nuit.

Edit : avec le test $A2<>DECALER($A2;-1; ) dans une fonction SI le calcul des formules est plus rapide :
Code: 
=REPT("X";SI($A2<>DECALER($A2;-1;);SIGNE(SOMMEPROD((E$1>=DECALER($B2;;;NB.SI($A:$A;$A2)))*(E$1<=DECALER($C2;;;NB.SI($A:$A;$A2)))))))
Fichier (1 bis).
 

Pièces jointes

  • congesst.2xlsm(1).xlsm
    48.6 KB · Affichages: 17
  • congesst.2xlsm(1 bis).xlsm
    63.3 KB · Affichages: 15
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour le fil, le forum,

Dans ce fichier (2) on choisit en B1 le mode de présentation, formule en E3 :
Code: 
=REPT("X";($B$1<>"")*SI($B$1="Ventiler";(E$2>=$B3)*(E$2<=$C3);SI($A3<>DECALER($A3;-1;);SIGNE(SOMMEPROD((E$2>=DECALER($B3;;;NB.SI($A:$A;$A3)))*(E$2<=DECALER($C3;;;NB.SI($A:$A;$A3))))))))
On notera que dans ce fichier comme dans les 2 précédents on n'utilise aucune macro.

Bonne journée.
 

Pièces jointes

  • congesst.2xlsm(2).xlsm
    51.8 KB · Affichages: 19
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour le forum,

Avec le VBA on peut masquer les lignes du tableau qui ne contiennent pas de "X" :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim H&, Ndates%
If Intersect(Target, [Choix]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Protect "jules", UserInterfaceOnly:=True 'si la feuille doit être protégée
If FilterMode Then ShowAllData 'si la feuille est filtrée
Rows([Debut].Row & ":" & Rows.Count).Hidden = False 'RAZ
[Nom].EntireColumn.Name = "Col" 'colonne(A) nommée
H = [Col].Cells(Rows.Count).End(xlUp).Row - [Debut].Row + 1
Ndates = Application.Count([Date].EntireRow)
If H <= 0 Or Ndates = 0 Then Exit Sub 'tableau vide
With [Debut].Resize(H, Ndates)
    .EntireRow.Sort [Nom], xlAscending, Header:=xlNo 'tri de sécurité
    .Formula = "=REPT(""X"",(Choix<>"""")*IF(Choix=""Ventiler"",(Date>=Du)*(Date<=Au),IF(Nom<>OFFSET(Nom,-1,),SIGN(SUMPRODUCT((Date>=OFFSET(Du,,,COUNTIF(Col,Nom)))*(Date<=OFFSET(Au,,,COUNTIF(Col,Nom))))))))"
    .Value = .Value 'supprime les formules
    If [Choix] <> "Ventiler" Then
        .EntireRow.Hidden = True 'masque toutes les lignes
        On Error Resume Next 'si aucune SpecialCell
        .SpecialCells(xlCellTypeConstants).EntireRow.Hidden = False 'affiche les lignes non vides
    End If
End With
End Sub
Avec les noms définis Choix Debut Date Nom Du Au le tableau peut être placé n'importe où.

Fichier (3), il y a une MFC pour colorer les cellules du tableau non vides.

A+
 

Pièces jointes

  • congesst.2xlsm(3).xlsm
    31.8 KB · Affichages: 18
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Si l'on veut pouvoir agrandir, trier, filtrer le tableau le plus simple est de ne pas protéger la feuille.

Et d'organiser le tableau en tableau Excel : la MFC s'ajuste automatiquement.

Voyez ce fichier (4) et ces macros :
Code: 
Private Sub CommandButton1_Click() 'MAJ
[Choix] = "Ventiler" 'lance la Worksheet_Change
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Choix]) Is Nothing Then Exit Sub
Dim H&, Ndates%
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With ListObjects(1).Range
    .AutoFilter: .AutoFilter 'si le tableau Excel est filtré
    .Rows.Hidden = False 'RAZ
    .Sort [Nom], xlAscending, Header:=xlYes 'tri sur les noms
    H = .Rows.Count - 1
End With
[Nom].EntireColumn.Name = "Col" 'colonne(A) nommée
Ndates = Application.Count([Date].EntireRow)
If Ndates = 0 Then Exit Sub 'sécurité
With [Debut].Resize(H, Ndates)
    .Formula = "=REPT(""X"",(Choix<>"""")*IF(Choix=""Ventiler"",(Date>=Du)*(Date<=Au),IF(Nom<>OFFSET(Nom,-1,),SIGN(SUMPRODUCT((Date>=OFFSET(Du,,,COUNTIF(Col,Nom)))*(Date<=OFFSET(Au,,,COUNTIF(Col,Nom))))))))"
    .Value = .Value 'supprime les formules
    If [Choix] <> "Ventiler" Then
        .EntireRow.Hidden = True 'masque toutes les lignes
        On Error Resume Next 'si aucune SpecialCell
        .SpecialCells(xlCellTypeConstants).EntireRow.Hidden = False 'affiche les lignes non vides
    End If
End With
End Sub
A+
 

Pièces jointes

  • congesst.2xlsm(4).xlsm
    36.9 KB · Affichages: 17
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Michel, Noël, le forum,
michel.dupont à dit:
un grand merci ...mais cela vole trop haut pour moi
Cliquez pour agrandir...
Contrairement à ce que vous pensez tout ce que j'ai proposé est relativement facile à comprendre.

Concernant l'utilisation des noms définis dans la formule c'est bien expliqué dans le fichier (3).

Et les codes VBA sont tout à fait classiques.

Si vous voulez progresser en VBA ne baissez pas les bras : posez des questions sur ce qui vous échappe.

Bonne journée.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Pour finir voici une solution bien meilleure mais nettement plus difficile à comprendre.

Il n'y a plus de bouton "MAJ", les "X" se placent automatiquement dès qu'on entre (ou efface) des dates en colonnes B et C.

Et l'on ne peut plus modifier les "X" manuellement.

La grosse subtilité ici c'est la désactivation de la propagation des formules dans le tableau :
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range
Set P = Intersect(ListObjects(1).DataBodyRange, Range([Debut], Columns(Columns.Count))) 'zone des "X"
If P Is Nothing Then Exit Sub
If Not Intersect(Target, [Choix]) Is Nothing Then
    Application.ScreenUpdating = False
    If FilterMode Then ShowAllData 'si la feuille est filtrée
    With ListObjects(1).Range
        .AutoFilter: .AutoFilter 'si le tableau Excel est filtré
        .Rows.Hidden = False 'RAZ
        .Sort [Nom], xlAscending, Header:=xlYes 'tri sur les noms
    End With
    [Nom].EntireColumn.Name = "Col" 'colonne(A) nommée
    Application.EnableEvents = False 'désactive les évènements
    P = "=REPT(""X"",(Choix<>"""")*IF(Choix=""Ventiler"",(Date>=Du)*(Date<=Au),IF(Nom<>OFFSET(Nom,-1,),SIGN(SUMPRODUCT((Date>=OFFSET(Du,,,COUNTIF(Col,Nom)))*(Date<=OFFSET(Au,,,COUNTIF(Col,Nom))))))))"
    P = P.Value 'supprime les formules
    Application.EnableEvents = True 'réactive les évènements
    If [Choix] <> "Ventiler" Then
        P.EntireRow.Hidden = True 'masque toutes les lignes
        On Error Resume Next 'si aucune SpecialCell
        P.SpecialCells(xlCellTypeConstants).EntireRow.Hidden = False 'affiche les lignes non vides
    End If
ElseIf Not Intersect(Target, ListObjects(1).DataBodyRange) Is Nothing Then
    If [Choix] <> "Ventiler" Then [Choix] = "Ventiler": Exit Sub
    Set P = Intersect(Target.EntireRow, P)
    Application.AutoCorrect.AutoFillFormulasInLists = False 'désactive la propagation des formules
    Application.EnableEvents = False 'désactive les évènements
    P = "=REPT(""X"",(Date>=Du)*(Date<=Au))"
    For Each P In P.Areas
        P = P.Value 'supprime les formules de chaque zone
    Next
    Application.EnableEvents = True 'réactive les évènements
    Application.AutoCorrect.AutoFillFormulasInLists = True 'réactive la propagation des formules
End If
End Sub
Fichier (5).

A+
 

Pièces jointes

  • congesst.2xlsm(5).xlsm
    34.8 KB · Affichages: 16
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Verrouiller des cellules sous plusieurs conditions
Réponses
0
Affichages
191
MONTREAL2020
M
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Affichage des résultats dans un tableau selon des conditions
Réponses
13
Affichages
297
chaelie2015
chaelie2015
D
  • Résolu(e)
XL 2010 Déplacer des lignes entières sous condition d'un tableau vers différents onglets
2
Réponses
20
Affichages
1 K
Djehnsr
D
L
  • Question
Microsoft 365 Changement de couleurs de cellules dans plusieurs feuilles suite à une modification
Réponses
4
Affichages
345
lolo_excelbeginner
L
J
  • Question
XL 2016 Regrouper automatiquement les cellules en supprimant les cellules sans affichage, colonne par colonne
Réponses
4
Affichages
662
jt25410
J
T
  • Question
XL 2016 Déplacer des mots dans d'autres colonnes
Réponses
3
Affichages
522
JHA
J
S
  • Question
XL 2016 Cellule change de couleur si la valeur existe dans une autre cellule d'un autre onglet
Réponses
12
Affichages
869
sum01
S
M
  • Résolu(e)
XL 2019 Mettre une valeur dans des cellules, en fonction d'une autre valeur
2
Réponses
15
Affichages
2 K
soan
S
Usine à gaz
  • Résolu(e)
Microsoft 365 copier des cellules sous conditions
Réponses
3
Affichages
872
Usine à gaz
Usine à gaz
T
  • Résolu(e)
XL 2016 Remplir un textbox avec des cellules appartenant à une même colonne sous 2 conditions
Réponses
6
Affichages
920
TechnologyNewStore
T

Membres actuellement en ligne

13 membres et 71 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 196
Messages
2 086 094
Membres
103 116
dernier inscrit
kutobi87