Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

VBA Tri sur sélection variable et ajout de somme et ligne sur intervale variable

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Bolak
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
B

Bolak

XLDnaute Nouveau
Bonjour,

Voici mes 2 problèmes:

1- Tri, j'ai créé une macro pour effectuer 2 tris dans le premier onglet de mon fichier (Macro "Tri", voir pièce jointe) le hic est que la sélection est fixe selon cette macro mais elle variera d'une fois à l'autre selon l'information dans le tableau. ce qui sépare les 2 tri est la ligne vierge au centre de l'onglet importation qui est aussi alléatoire mais qui peut être identifié selon la date. (elle est jaune présentement mais c'est seulement pour vous la montrer). J'imagine que ce n'est pas une grosse modification à faire mais je ne sais pas par où commencer.

2- Une fois trié, j'aimerai que mon tableau ajoute des lignes tel que fait manuellement dans l'onglet "résultat souhaité". Soit selon la colonne B, ajouter une ligne et des sommes dans la colonne H et I immédiatement à la suite du dernier numéro identique de la colonne B. (voir couleur grise dans l'onglet résultat souhaité)
Autre contrainte, si à l'intérieur du même nombre de numéro identique de la colonne B il y a des numéros différents dans la colonne C il faudrait une somme séparée par numéro de la colonne C pour la colonne H. (voir couleur bleu dans onglet résultat souhaité)

Je suis débutant avec le VBA, j'ai fouillé dans recherche mais je n'arrive pas à me retrouver.

Merci d'avance à toute aide apporté, cela nous simplifiera la vie grandement!
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
Re : VBA Tri sur sélection variable et ajout de somme et ligne sur intervale variable

Bonsoir le forum,
Bonsoir Bolak,

Ce qui est compliqué, c'est de décrypter ta demande 🙄
J'ai considéré que la feuille "Importation" était déjà triée par comparaison avec la feuille "Résultat souhaité"
Donc j'ai fait l'impasse sur le point 1.

Traitement du point 2 :
Exécute ces 2 macros successivement, la feuille active doit être la feuille "Importation"
Pour bien visualiser, les lignes insérées sont en vert soit les sous-totaux si j'ai bien compris.

VB: 
Sub InsererLignes()
Dim Lig As Long
Application.ScreenUpdating = False
Range("A" & Range("A65536").End(xlUp).Row + 1 & ":J" & Range("A65536").End(xlUp).Row + 1).Interior.ColorIndex = 43
For Lig = Range("A65536").End(xlUp).Row To 2 Step -1
 If Range("B" & Lig - 1) <> "" Then
   If Range("B" & Lig) <> Range("B" & Lig - 1) Or Range("C" & Lig) <> Range("C" & Lig - 1) Then
     Range("A" & Lig).EntireRow.Insert
     Range("A" & Lig & ":J" & Lig).Interior.ColorIndex = 43
   End If
 End If
Next
Application.ScreenUpdating = False
End Sub

Traitement des données bloc par bloc :
VB: 
Sub Sous_Totaux_Par_Blocs()
dl = Range("A65536").End(xlUp).Row
x = 1
Do
    If Range("A" & x + 1) = "" Then
      y = Range("A" & x).Row
    Else
      y = Range("A" & x).End(xlDown).Row
    End If
    z = Range("A" & y).End(xlDown).Row
    w = z - y
    Range("B" & y + 1 & ":C" & y + 1).Value = Range("B" & y & ":C" & y).Value
    Range("G" & y + 1).Value = "Totaux"
    Range("H" & y + 1).Value = Application.Sum(Range("H" & x & ":H" & y))
    Range("I" & y + 1).Value = Application.Sum(Range("I" & x & ":I" & y))
    x = y + w
Loop Until x > dl
End Sub

Une variante :
VB: 
Sub Sous_Totaux_Par_Blocs()
dl = Range("A65536").End(xlUp).Row
x = 1: y = 1
Do
    Do Until Range("A" & y) = ""
      y = y + 1
    Loop
    z = Range("A" & y - 1).End(xlDown).Row
    w = z - y + 1
    Range("B" & y & ":C" & y).Value = Range("B" & y - 1 & ":C" & y - 1).Value
    Range("G" & y).Value = "Totaux"
    Range("H" & y).Formula = "=SUM(" & Range("H" & x).Address & ":" & Range("H" & y - 1).Address & ")"
    'Range("H" & y).Value = Application.Sum(Range("H" & x & ":H" & y - 1))
    Range("I" & y).Value = Application.Sum(Range("I" & x & ":I" & y - 1))
    x = y - 1 + w
    y = x
Loop Until x > dl
End Sub

J'ai un doute sur le calcul des sous-totaux en colonne I

Klin89
 
Dernière édition:
Vote positif 0 Vote négatif
Re : VBA Tri sur sélection variable et ajout de somme et ligne sur intervale variable

Bonjour le forum 🙂

Comme dit précédemment, j'ai revu les sous-totaux de la colonne I.
Pour que tu comprennes bien le déroulement du programme, j'ai procédé en 3 temps :
La feuille active doit être la feuille "Importation".

Insertion des lignes :
VB: 
Sub InsererLignes()
Dim Lig As Long
Application.ScreenUpdating = False
For Lig = Range("A65536").End(xlUp).Row To 2 Step -1
 If Range("B" & Lig - 1) <> "" Then
   If Range("B" & Lig) <> Range("B" & Lig - 1) Or Range("C" & Lig) <> Range("C" & Lig - 1) Then
     Range("A" & Lig).EntireRow.Insert
     'Range("A" & Lig & ":J" & Lig).Interior.ColorIndex = 43
   End If
 End If
Next
Application.ScreenUpdating = False
End Sub

Sous-Totaux en colonne H :
VB: 
Sub Sous_Totaux_Par_Blocs_Colonne_H()
dl = Range("A65536").End(xlUp).Row
x = 1: y = 1
Do
    Do Until Range("A" & y) = ""
      y = y + 1
    Loop
    z = Range("A" & y - 1).End(xlDown).Row
    w = z - y + 1
    Range("G" & y).Value = "Totaux"
    With Range("B" & y & ":C" & y)
      .Value = Range("B" & y - 1 & ":C" & y - 1).Value
      .Interior.ColorIndex = 24
    End With
    With Range("H" & y)
      .Formula = "=SUM(" & Range("H" & x).Address & ":" & Range("H" & y - 1).Address & ")"
      .Interior.ColorIndex = 24
    End With
    x = y - 1 + w
    y = x
Loop Until x > dl
End Sub

Sous-Totaux en colonne I :
VB: 
Sub Sous_Totaux_Par_Blocs_Colonne_I()
dl = Range("A65536").End(xlUp).Row
x = 1: y = 1
Do
    Do Until Range("B" & y + 1) <> Range("B" & y)
      y = y + 1
    Loop
    z = Range("A" & y - 1).End(xlDown).Row
    w = z - y + 1
    Range("I" & y).Formula = "=SUM(" & Range("I" & x).Address & ":" & Range("I" & y - 1).Address & ")"
    Range("B" & y & ":C" & y).Interior.ColorIndex = 15
    Range("H" & y & ":I" & y).Interior.ColorIndex = 15
    x = y - 1 + w
    y = x
Loop Until x > dl
End Sub

A tester.

Klin89
 
Dernière édition:
Vote positif 0 Vote négatif
Re : VBA Tri sur sélection variable et ajout de somme et ligne sur intervale variable

Re Bolak,

Vois aussi cela :

VB: 
Sub InsererLignes()
Dim Lig As Long, DerLig As Long
Application.ScreenUpdating = False
DerLig = Range("A65536").End(xlUp).Row
With Range("B" & DerLig + 1 & ":C" & DerLig + 1)
  .Value = Range("B" & DerLig & ":C" & DerLig).Value
  .Interior.ColorIndex = 24
End With
Range("G" & DerLig + 1).Value = "Totaux"
Range("H" & DerLig + 1).Interior.ColorIndex = 24
For Lig = DerLig To 2 Step -1
 If Range("B" & Lig - 1) <> "" Then
   If Range("B" & Lig) <> Range("B" & Lig - 1) Or Range("C" & Lig) <> Range("C" & Lig - 1) Then
     Range("A" & Lig).EntireRow.Insert
     Range("G" & Lig).Value = "Totaux"
     With Range("B" & Lig & ":C" & Lig)
      .Value = Range("B" & Lig - 1 & ":C" & Lig - 1).Value
      .Interior.ColorIndex = 24
     End With
     Range("H" & Lig).Interior.ColorIndex = 24
  End If
 End If
Next
Application.ScreenUpdating = False
End Sub

VB: 
Sub Sous_Totaux_Par_Blocs_Colonne_H_I()
dl = Range("A65536").End(xlUp).Row
x = 1: y = 1: r = 1
Do
    Do Until Range("B" & y + 1) <> Range("B" & y)
      If Range("C" & y + 1) <> Range("C" & y) Then
        Range("H" & y).Formula = "=SUM(" & Range("H" & r).Address & ":" & Range("H" & y - 1).Address & ")"
        r = Range("H" & y + 1).Row
      End If
      y = y + 1
    Loop
    Range("H" & y).Formula = "=SUM(" & Range("H" & r).Address & ":" & Range("H" & y - 1).Address & ")"
    Range("I" & y).Formula = "=SUM(" & Range("I" & x).Address & ":" & Range("I" & y - 1).Address & ")"
    Union(Range("B" & y & ":C" & y), Range("H" & y & ":I" & y)).Interior.ColorIndex = 15
    z = Range("A" & y - 1).End(xlDown).Row
    w = z - y + 1: x = y - 1 + w
    y = x: r = x
Loop Until x > dl
End Sub

Bien évidemment à tester.

Edit : cela doit être bon, j'ai modifié le code ci-dessus post #6

Pour une macro de tri, vois ce lien :

https://www.excel-downloads.com/threads/macro-tri_range-sort.174117/

Klin89
 
Dernière édition:
Vote positif 0 Vote négatif
Re : VBA Tri sur sélection variable et ajout de somme et ligne sur intervale variable

Wow super! Merci Klin89.

De mon côté j'avais aussi avancé une solution, mais je vais essayer de l'adapter à la tienne pour garder ce qui est de mieux.

Pour mon 1er problème de tri, étant donné que les données n'auront pas le même nombre de ligne d'une fois à l'autre j'ai mis une variable qui fera un décompte du nombre de ligne:

Code: 
Dim fin1tri As Integer, fin2tri As Integer
'déterminer les fin de tri de la semaine 1 et 2 pour l'intervale
Range("A1").Select
fin1tri = Range(Selection, Selection.End(xlDown)).Count
Range("A" & fin1tri + 2).Select
fin2tri = Range(Selection, Selection.End(xlDown)).Count + fin1tri + 1
Range("A" & fin2tri).Select

    ActiveWorkbook.Worksheets("Importation").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Importation").Sort.SortFields.Add Key:=Range("b1:b" & fin1tri), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("Importation").Sort.SortFields.Add Key:=Range("c1:c" & fin1tri), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Importation").Sort
        .SetRange Range("A1:K" & fin1tri)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveWorkbook.Worksheets("Importation").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Importation").Sort.SortFields.Add Key:=Range("b" & fin1tri + 2 & ":b" & fin2tri), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("Importation").Sort.SortFields.Add Key:=Range("c" & fin1tri + 2 & ":c" & fin2tri), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Importation").Sort
        .SetRange Range("A" & fin1tri + 2 & ":K" & fin2tri)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Pour ajouter les sommes par groupe d'employé, j'avais mis une boucle For mais avec un interval fixe de 800 boucles... Je vais corriger ceci...

Code: 
Dim ligne As Integer, interval1 As Integer, interval2 As Integer

Sheets("Importation").Select

For ligne = 1 To 800
    If Cells(ligne, 1).Value > 0 Then
        ' si le numero d'employé suivant est identique et le numero de tache aussi
        If Cells(ligne, 2).Value = Cells(ligne + 1, 2).Value And Cells(ligne, 3).Value = Cells(ligne + 1, 3).Value Then
            interval1 = interval1 + 1
        Else ' Si le numero suivant d'employé ou de tache n'est pas identique faire plus bas
            Cells(ligne + 1, 2).Select
            Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            ' ajouter somme colonne H selon le premier interval
            Cells(ligne + 1, 8).Select
            Range("h" & ligne + 1) = "=SUM(H" & ligne - interval1 & ":h" & ligne & ")/100"
            ' ajouter somme colonne I selon le premier interval
            Cells(ligne + 1, 9).Select
            Range("i" & ligne + 1) = "=SUM(i" & ligne - interval1 & ":i" & ligne & ")/100"
            'copie info col B et C
            Cells(ligne, 2).Select
            Selection.Copy
            Cells(ligne + 1, 2).Select ' B # employé
            ActiveSheet.Paste
            Cells(ligne, 3).Select
            Selection.Copy
            Cells(ligne + 1, 3).Select ' C # tache
            ActiveSheet.Paste
            Cells(ligne, 6).Select
            Selection.Copy
            Cells(ligne + 1, 6).Select ' F taux horaire
            ActiveCell.FormulaR1C1 = "=R[-1]C/100"
            Application.CutCopyMode = False
            ' reset interval
            interval1 = 0
        End If
    End If
Next ligne
        
End Sub

À force de lire le web, je commence à me débrouiller! 🙂 Merci encore de ton aide.
 
Vote positif 0 Vote négatif
Re : VBA Tri sur sélection variable et ajout de somme et ligne sur intervale variable

Rebonjour,

Suite à ce travail, est-ce possible de simplifier le code que j'ai à faire par la suite? En fait, je ne veux que copier mes sous-totaux dans une nouvelle feuille(copier en valeur), je le fais comme si je le ferais manuellement, il doit y avoir une autre façon moins longue que ça j'imagine?

Code: 
Sub E_exporation_interface()
Dim Ligneimp As Integer, Dl As Integer
Dim Ligneint As Integer
Dim valeurover As Double
Dim semaine As Integer
Ligneimp = 0
Ligneint = 0
semaine = 1
Dl = Range("B65536").End(xlUp).Row
Sheets("Importation").Select
For Ligneimp = 1 To Dl
    Sheets("Importation").Select
    If Cells(Ligneimp, 1).Value = 0 Then
    If Cells(Ligneimp, 2).Value > 0 Then
        Ligneint = Ligneint + 1
        Sheets("Importation").Select
        'copie colonne B importation # employé
        Cells(Ligneimp, 2).Copy
        Sheets("Interface").Select
        Cells(Ligneint, 2).Select
        ActiveSheet.Paste
        'copie colonne C importation # tache
        Sheets("Importation").Select
        Cells(Ligneimp, 3).Copy
        Sheets("Interface").Select
        Cells(Ligneint, 3).Select
        ActiveSheet.Paste
        'copie colonne F importation # taux
        Sheets("Importation").Select
        Cells(Ligneimp, 6).Copy
        Sheets("Interface").Select
        Cells(Ligneint, 7).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'copie colonne H importation # heure regulière
        Sheets("Importation").Select
        Cells(Ligneimp, 8).Copy
        Sheets("Interface").Select
        Cells(Ligneint, 6).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Cells(Ligneint, 9).Value = semaine
        Sheets("Importation").Select
        If Cells(Ligneimp, 9) > 0 Then
            Ligneint = Ligneint + 1
            Sheets("Importation").Select
            'copie colonne B importation # employé
            Cells(Ligneimp, 2).Copy
            Sheets("Interface").Select
            Cells(Ligneint, 2).Select
            ActiveSheet.Paste
            'copie colonne C importation # tache overtime
            Sheets("Interface").Select
            Cells(Ligneint, 3).Value = 43
            'copie colonne F importation # taux
            Sheets("Importation").Select
            Cells(Ligneimp, 6).Copy
            Sheets("Interface").Select
            Cells(Ligneint, 7).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            'copie colonne I importation # heure regulière
            Sheets("Importation").Select
            Cells(Ligneimp, 9).Copy
            Sheets("Interface").Select
            Cells(Ligneint, 30).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            'mettre colonne f interface les heures over
            Cells(Ligneint, 6).Value = Cells(Ligneint, 30).Value
            Cells(Ligneint, 9).Value = semaine
            'refaire une DEUXIÈME ligne pour soustraire du regulier
            Sheets("Importation").Select
            Ligneint = Ligneint + 1
            Sheets("Interface").Select
            'copie colonne B importation # employé
            Sheets("Importation").Select
            Cells(Ligneimp, 2).Copy
            Sheets("Interface").Select
            Cells(Ligneint, 2).Select
            ActiveSheet.Paste
            'copie colonne C importation # tache
            Sheets("Importation").Select
            Cells(Ligneimp, 3).Copy
            Sheets("Interface").Select
            Cells(Ligneint, 3).Select
            ActiveSheet.Paste
            'copie colonne F importation # taux
            Sheets("Importation").Select
            Cells(Ligneimp, 6).Copy
            Sheets("Interface").Select
            Cells(Ligneint, 7).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            'copie colonne I importation # heure regulière négatif
            Sheets("Importation").Select
            valeurover = -Cells(Ligneimp, 9).Value
            Sheets("Interface").Select
            Cells(Ligneint, 29).Value = valeurover
            'mettre colonne f interface les heures over
            Cells(Ligneint, 6).Value = Cells(Ligneint, 29).Value
            Cells(Ligneint, 9).Value = semaine
        End If
    Else: semaine = semaine + 1
    End If
    End If
Next Ligneimp
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : VBA Tri sur sélection variable et ajout de somme et ligne sur intervale variable

Question de forum, comment je peux afficher le code en VBA avec les couleur? Ce serait plus claire...
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Résolu(e)
Microsoft 365 Découper un fichier en plusieurs fichiers
2
Réponses
24
Affichages
259
nat54
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
1 K
Gestionnaire_rh
G
B
  • Question Question
XL 2021 VBA pour générer une liste de valeurs comprise entre 2 valeurs
2
Réponses
16
Affichages
516
benjy555
B
A
  • Question Question
Microsoft 365 Tri sur feuille protégée +Aide protection de données déjà saisies
Réponses
2
Affichages
292
TooFatBoy
P
  • Résolu(e)
XL 2019 Tri sur une ligne dans un tableau.
Réponses
4
Affichages
255
Paulle
P
S
  • Résolu(e)
XL 2013 Copier-Coller une ligne dans tableau variable, et la manipuler.
Réponses
4
Affichages
268
StéphaneDeLà
S
S
  • Résolu(e)
Microsoft 365 Choisircols et ajout de colonne
Réponses
14
Affichages
302
AtTheOne
A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
459
Abi23
A
P
  • Question Question
XL 2016 Macro VBA remplissage tableau de synthèse % déchet ligne de production
Réponses
4
Affichages
298
vgendron
F
  • Question Question
XL 2021 sélection de colonne et ordonnancement des colonnes en déclarant en variable les entêtes
Réponses
2
Affichages
497
ftpo69
F
A
  • Résolu(e)
Microsoft 365 NB.SI sous condition_fusionner deux formules
Réponses
10
Affichages
394
job75
  • Question Question
Microsoft 365 Recherche incomplète planning (problème de dates)
Réponses
13
Affichages
538
p56
H
  • Question Question
XL 2013 Saisie sécurisée numéros de téléphone et ajout fonction clic droit de la souris
2
Réponses
21
Affichages
939
Helios77
H
F
  • Résolu(e)
XL 2021 VBA et Power Query : ecrire des requetes avec variables
2
Réponses
28
Affichages
2 K
Florent74
F
X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
9
Affichages
395
xavieralvaro
X
D
  • Résolu(e)
Microsoft 365 Problème de déclaration de type de variable - argument ByRef incompatible
Réponses
4
Affichages
341
DidPouAxi
D
  • Question Question
Microsoft 365 Bug liste de validation sur fichier de menu/Repas
2
Réponses
17
Affichages
762
ChTi160
N
  • Question Question
Microsoft 365 excel sommes si ens en ligne ou somme prod.
Réponses
4
Affichages
524
nicolulu
N
EXCEL :: TRIER - TRIER.PAR - SOMMEPROD - CHOISIR - INDEX - SOMME.SI - NB.SI - DECALER - SEQUENCE : Tris dynamiques, regroupements et somme
Réponses
0
Affichages
375
oguruma
H
  • Question Question
Microsoft 365 Calcul d'une somme de données entre 2 dates (1 ancienne et aujourd'hui)
Réponses
13
Affichages
986
Heian911
H
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…