Microsoft 365 VBA - TRI TABLEAU

Daher Ali

XLDnaute Junior
Bonjour,
j'ai un soucis et j'aimerais que quelqu'un m'aider...
j'ai fait un code qui tri mon tableau qui comporte 6 colonnes, le code marche très bien, mais j'aimerais bloquer le tri de la colonne 5 et 6 car j'ai des formules :

E5 =SIERREUR(SI.CONDITIONS(B5="SALAIRE";+D5;B5="AVANCE";-D5;B5="SOLDE SALAIRE";-D5;B5="REMB";-D5;B5="CONGE";+D5;B5="PRET";0);"")
E6 =SIERREUR(E5+SI.CONDITIONS(B6="SALAIRE";+D6;B6="AVANCE";-D6;B6="SOLDE SALAIRE";-D6;B6="REMB";-D6;B6="CONGE";+D6;B6="PRET";0);"")
puis j'étire ma formule jusqu'en bas.

F5 =SIERREUR(SI.CONDITIONS(B5="SALAIRE";0;B5="AVANCE";0;B5="SOLDE SALAIRE";;B5="REMB";-D5;B5="CONGE";0;B5="PRET";+D5);"")
F6 =SIERREUR(F5+SI.CONDITIONS(B6="SALAIRE";0;B6="AVANCE";0;B6="SOLDE SALAIRE";;B6="REMB";-D6;B6="CONGE";0;B6="PRET";+D6);"")
puis j'étire ma formule jusqu'en bas.

lorsque je fait le tri mes formules ce mélange ou bouge pour cela j'aimerais bloquer le tri de ces 2 colonnes ( 5 et 6 ) ou modifier ces formules pour que le tri ce face correctement. Autre chose que j'aimerai ajouter : tant que la cellule de la 4éme colonne n'est pas saisi le tri ne fonctionne pas.
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
If ActiveCell.ListObject Is Nothing Then Exit Sub
  For s = 2 To Sheets.Count
  For Each n In Sheets(s).ListObjects
  Range(n).Sort key1:=Range(n & "[DATE]"), Header:=xlYes, Order1:=xlAscending
  Next n
  Next s
 'NomTableau = "Client"
End Sub

merci
 
Solution
VB:
Sub TriTableaux()
  For Each s In Array(1, 3, 4)  'feuilles 1, 3,4
    For Each n In Sheets(s).ListObjects
       nom = n.Name
       Range(nom).Sort key1:=Range(nom).Columns(1), Header:=xlYes, Order1:=xlAscending
    Next n
  Next s
End Sub


Boisgontier

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

Exemple qui ne pose pas de pb

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([tableau1[nom]], Target) Is Nothing And Target.Count = 1 Then
     [tableau1].Sort key1:=[tableau1[nom]], Header:=xlYes, Order1:=xlAscending
  End If
  If Not Intersect([tableau3[montant ht]], Target) Is Nothing And Target.Count = 1 Then
     [tableau3].Sort key1:=[tableau3[montant ht]], Header:=xlYes, Order1:=xlAscending
  End If
End Sub

Boisgontier
 

Pièces jointes

  • Classeur1.xlsm
    18.9 KB · Affichages: 6

Nairolf

XLDnaute Accro
Salut,

En plus du traitement vba que te propose Boisgontier, je te soumets les formules simplificatrices suivantes qui permettent d'avoir une formule unique par colonne :
- à étirer vers le bas à partir de "E5" :
Code:
=SIERREUR(SOMMEPROD(SI.CONDITIONS($B$5:B5="SALAIRE";+$D$5:D5;$B$5:B5="AVANCE";-$D$5:D5;$B$5:B5="SOLDE SALAIRE";-$D$5:D5;$B$5:B5="REMB";-$D$5:D5;$B$5:B5="CONGE";+$D$5:D5;$B$5:B5="PRET";0));"")
- à étirer vers le bas à partir de "F5" :
Code:
=SIERREUR(SOMMEPROD(SI.CONDITIONS($B$5:B5="SALAIRE";0;$B$5:B5="AVANCE";0;$B$5:B5="SOLDE SALAIRE";;$B$5:B5="REMB";-$D$5:D5;$B$5:B5="CONGE";0;$B$5:B5="PRET";+$D$5:D5));"")
 

Daher Ali

XLDnaute Junior
Salut,

En plus du traitement vba que te propose Boisgontier, je te soumets les formules simplificatrices suivantes qui permettent d'avoir une formule unique par colonne :
- à étirer vers le bas à partir de "E5" :
Code:
=SIERREUR(SOMMEPROD(SI.CONDITIONS($B$5:B5="SALAIRE";+$D$5:D5;$B$5:B5="AVANCE";-$D$5:D5;$B$5:B5="SOLDE SALAIRE";-$D$5:D5;$B$5:B5="REMB";-$D$5:D5;$B$5:B5="CONGE";+$D$5:D5;$B$5:B5="PRET";0));"")
- à étirer vers le bas à partir de "F5" :
Code:
=SIERREUR(SOMMEPROD(SI.CONDITIONS($B$5:B5="SALAIRE";0;$B$5:B5="AVANCE";0;$B$5:B5="SOLDE SALAIRE";;$B$5:B5="REMB";-$D$5:D5;$B$5:B5="CONGE";0;$B$5:B5="PRET";+$D$5:D5));"")
Merci à toi, c'est génial :)
 

Daher Ali

XLDnaute Junior
Bonjour,

Exemple qui ne pose pas de pb

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([tableau1[nom]], Target) Is Nothing And Target.Count = 1 Then
     [tableau1].Sort key1:=[tableau1[nom]], Header:=xlYes, Order1:=xlAscending
  End If
  If Not Intersect([tableau3[montant ht]], Target) Is Nothing And Target.Count = 1 Then
     [tableau3].Sort key1:=[tableau3[montant ht]], Header:=xlYes, Order1:=xlAscending
  End If
End Sub

Boisgontier
Merci à toi aussi cela fonctionne très bien mais j'ai appliquer code sans désigné le nom du tableau car j'ai plusieurs feuilles qui doivent avoir le même code vba, pur cela je préfère ne pas métre le nom du tableau de chaque feuille? sa me fera beaucoup de travail.
et plus je disais que je préfère que mon code fonction que lorsque je fini de remplire la ligne ( de colonne A a colonne D ) le tri s'exécute en colonne A
 

Daher Ali

XLDnaute Junior
Merci à toi aussi cela fonctionne très bien mais j'ai appliquer code sans désigné le nom du tableau car j'ai plusieurs feuilles qui doivent avoir le même code vba, pur cela je préfère ne pas métre le nom du tableau de chaque feuille? sa me fera beaucoup de travail.
et plus je disais que je préfère que mon code fonction que lorsque je fini de remplire la ligne ( de colonne A a colonne D ) le tri s'exécute en colonne A
Bonjour, désolé du deranement, pourriez vous m'aidez svp.
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,


Tri tous les tableaux du classeur en colonnne 1

VB:
Sub NomsTableaux()
  For s = 1 To Sheets.Count
    For Each n In Sheets(s).ListObjects
       nom = n.Name
       Range(nom).Sort key1:=Range(nom).Columns(1), Header:=xlYes, Order1:=xlAscending
    Next n
  Next s
End Sub


Boisgontier
 

Pièces jointes

  • TriTableaux.xlsm
    23.1 KB · Affichages: 3

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
VB:
Sub TriTableaux()
  For Each s In Array(1, 3, 4)  'feuilles 1, 3,4
    For Each n In Sheets(s).ListObjects
       nom = n.Name
       Range(nom).Sort key1:=Range(nom).Columns(1), Header:=xlYes, Order1:=xlAscending
    Next n
  Next s
End Sub


Boisgontier
 

Pièces jointes

  • TriTableaux2.xlsm
    28.6 KB · Affichages: 5

Daher Ali

XLDnaute Junior
VB:
Sub TriTableaux()
  For Each s In Array(1, 3, 4)  'feuilles 1, 3,4
    For Each n In Sheets(s).ListObjects
       nom = n.Name
       Range(nom).Sort key1:=Range(nom).Columns(1), Header:=xlYes, Order1:=xlAscending
    Next n
  Next s
End Sub


Boisgontier
Je vous remercie, j'ai pu avoir mon code finalement:);)
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
If ActiveCell.ListObject Is Nothing Then Exit Sub
  For s = 2 To Sheets.Count
  For Each n In Sheets(s).ListObjects
If Target.Column = 4 Then
  Range(n & "[[DATE]:[MONTANT]]").Sort key1:=Range(n & "[DATE]"), Order1:=xlAscending, Header:=xlYes
End If
  Next n
  Next s
End Sub
 

Discussions similaires

Réponses
9
Affichages
401

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof