Résolu Insertion ligne en dessous du dernier élément de la condition

fopy12

Habitué
Salut tout le monde,
J’aurai besoin d’une aide. J’ai un tableau avec une colonne H où se trouvent des montants. J’ai fait une macro qui fait la somme de ces montants s’ils sont < à 10 000, s’ils sont entre 4 000 et 10 000 et s’ils sont < à 4 000.
Et à chaque fois il faut insérer une ligne en dessous du dernier montant qui est < à 10 000, (pareil pour le dernier montant compris entre 4 000 et 10 000 et celui < à 4 000). Et c’est dans cette ligne insérée où il faut mettre la somme dans chaque cas.
Ma macro marche sauf pour ce qui est du dernier cas. Il me met la somme à 65536 ième ligne ; ce n’est pas terrible. A votre avis qu’est ce qui cloche ?
Au début je l’ai adapté à 390 lignes et pas de soucis. Mais mon nombre de lignes change toutes les semaines, c’est pour cela que j’ai mis de for i de 1 à 65536.

Code:
Sub TrierEtSommeSI()

' trier le tableau de données
    Sheets("Général").Select
    Range("A1:L390").Select
    Selection.Sort Key1:=Range("H2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
' boucle
For i = 2 To 65536
    If Range("H" & i).Value >= 10000 Then
        SommeSup = SommeSup + Range("H" & i).Value
        DernierSup = i
        
    ElseIf Range("H" & i).Value >= 4000 And Range("H" & i).Value < 10000 Then
        SommeInf = SommeInf + Range("H" & i).Value
        DernierInf = i
    Else
        SommeReste = SommeReste + Range("H" & i).Value
        DernierReste = i
    End If
Next i

Range("H" & DernierSup + 1).EntireRow.Insert
Range("A" & DernierSup + 1).Value = "Somme des éléments >= 10000"
Range("H" & DernierSup + 1).Value = SommeSup

Range("H" & DernierInf + 2).EntireRow.Insert
Range("A" & DernierInf + 2).Value = "Somme des éléments >=4000 et < 10000"
Range("H" & DernierInf + 2).Value = SommeInf

Range("H" & DernierReste + 3).EntireRow.Insert
Range("A" & DernierReste + 3).Value = "Somme des éléments < 4000"
Range("H" & DernierReste + 3).Value = SommeReste

End Sub
Merci d’avance pour votre aide !!
 

zeb

Modérateur
Meilleure réponse
Salut,

Rholala.... M'enfin, pourquoi ligne 5, sélectionnes-tu une zone pour ensuite appliquer le tri sur la sélection en cours. Abrège ton code, et applique le tri sur la zone directement. :spamafote:

Grâce à l'aide en ligne, découvre la méthode Cells(). Elle est plus agréable à utiliser que Range() dans ton cas.

En fait, il ne faut pas que tu boucles sur autant de lignes que cela.
Pour déterminer la dernière ligne, inspire-toi de ce topic :
 

fopy12

Habitué



salut zeb , voila ce que j'ai réussi à faire gra à ton topic. ça fonctionne.
Code:
Sub TrierEtSommeSI()

 

Worksheets("Feuil1").Range("A1").Sort Key1:=Worksheets("Feuil1").Columns("H"), order1:=xlDescending, Header:=xlGuess

 

' boucle

For i = 2 To 10000

 

    If Range("H" & i).Value >= 10000 Then

        SommeSup = SommeSup + Range("H" & i).Value

        derniersup = i

        

    ElseIf Range("H" & i).Value >= 4000 And Range("H" & i).Value < 10000 Then

        SommeInf = SommeInf + Range("H" & i).Value

        dernierinf = i

    Else

        SommeReste = SommeReste + Range("H" & i).Value

    End If

Next

 

 

 

Range("H" & derniersup + 1).EntireRow.Insert

Range("G" & derniersup + 1).Value = "Total des retards >= 10 000"

Range("G" & derniersup + 1).Font.Bold = True

Range("G" & derniersup + 1).HorizontalAlignment = xlRight

Range("H" & derniersup + 1).Value = SommeSup

Range("H" & derniersup + 1).Font.Bold = True

 

Range("H" & dernierinf + 2).EntireRow.Insert

Range("G" & dernierinf + 2).Value = "Total des retards entre 4 000 et 10 000"

Range("G" & dernierinf + 2).Font.Bold = True

Range("G" & dernierinf + 2).HorizontalAlignment = xlRight

Range("H" & dernierinf + 2).Value = SommeInf

Range("H" & dernierinf + 2).Font.Bold = True

 

Cells(Rows.Count, 7).End(xlUp).Offset(1).Select

Cells(Rows.Count, 7).End(xlUp).Offset(1).Value = "Total des retards < 4000"

Cells(Rows.Count, 7).End(xlUp).Font.Bold = True

Cells(Rows.Count, 7).End(xlUp).Offset(1).HorizontalAlignment = xlRight

Cells(Rows.Count, 8).End(xlUp).Offset(1).Value = SommeReste

Cells(Rows.Count, 8).End(xlUp).Font.Bold = True

 

 

End Sub
 

zeb

Modérateur
pffffffffffff ! Eh ben...

A la ligne 11, remplace le grand nombre par le numéro de la dernière ligne.
Ligne 5, tu précises la feuille. C'est bien. A toutes les autres lignes, tu ne le fait pas. C'est mal.
Ligne 71 et suivantes, tu utilises Cells(). C'est bien. Partout ailleurs, tu utilises Range(), c'est idiot.
Ligne 71, tu sélectionnes une ligne. Pour quoi faire ?
Ligne 71 et suivantes, tu fais beaucoup de calculs inutiles !
Lignes 75 et 81, t'es sûr que tu es sur la bonne ligne ?

---------------------

Code:
// Premier jet
Dim ws         As Worksheets
Dim cel        As Range
Dim SommeSup   As Double
Dim SommeReste As Double
Dim derniersup As Long
Dim dernierinf As Long

Set ws = Worksheets("Feuil1" )

ws.Range("A1" ).Sort Key1:=ws.Columns("H"), order1:=xlDescending, Header:=xlGuess

For i = 2 To ws.Cells(Rows.Count, 8).End(xlUp).Row
    If Cells(i, 8).Value >= 10000 Then
        SommeSup = SommeSup + Cells(i, 8).Value
        derniersup = i           
    ElseIf Cells(i, 8).Value >= 4000 And Cells(i, 8).Value < 10000 Then
        SommeInf = SommeInf + Cells(i, 8).Value
        dernierinf = i
    Else
        SommeReste = SommeReste + Cells(i, 8).Value
    End If
Next

set cel = Cells(derniersup + 1, 7)
cel.EntireRow.Insert
cel.Value = "Total des retards >= 10 000"
cel.Font.Bold = True
cel.HorizontalAlignment = xlRight
Set cel = cel.Offset(1)
cel.Value = SommeSup
cel.Font.Bold = True

set cel = Cells(derniersup + 1, 7)
cel.EntireRow.Insert
cel.Value = "Total des retards entre 4 000 et 10 000"
cel.Font.Bold = True
cel.HorizontalAlignment = xlRight
Set cel = cel.Offset(1)
cel.Value = SommeInf
cel.Font.Bold = True

Set cel = Cells(Rows.Count, 7).End(xlUp).Offset(1)
cel.Value = "Total des retards < 4000"
cel.Font.Bold = True
cel.HorizontalAlignment = xlRight
Set cel = cel.Offset(1)
cel.Value = SommeReste
cel.Font.Bold = True
Bon. Y'a un peu moins de calcul. Mais on peut pousser le vice plus loin : Les trois derniers blocs sont "presque" identiques. Et on se traîne des indices alors qu'on peut utiliser directement les objets.

Code:
Sub NewLine(line As Range, title As String, value As Double)
    line.EntireRow.Insert
    With line.Columns("G")
      .Value = title
      .HorizontalAlignment = xlRight
      .Font.Bold = True
    End With
    With line.Columns("H")
      .Value = value
      .Font.Bold = True
    End With
End Sub
Code:
Sub TrierEtSommeSI()// Nouveau code
    Dim ws         As Worksheets
    Dim cel        As Range
    Dim SommeSup   As Double
    Dim SommeInf   As Double
    Dim SommeRst   As Double   
    Dim LineSup    As Range
    Dim LineInf    As Range
    Dim LineRst    As Range
    
    Set ws = Worksheets("Feuil1")   
    ws.Range("A1" ).Sort Key1:=ws.Columns("H"), order1:=xlDescending, Header:=xlYes
    
    Set LineRst = ws.Cells(ws.Rows.Count, 8).End(xlUp).EntireRow
    For Each cel In Range(ws.Rows(2), LineRst).Columns("H")
        Select Case cel.Value
            Case Is >= 10000
                SommeSup = SommeSup + cel.Value
                LineSup = cel.EntireRow
            Case Is >= 4000
                SommeInf = SommeInf + cel.Value
                LineInf = cel.EntireRow           
            Case Else
                SommeRst = SommeRst + cel.Value
        End Select
    Next
    
    NewLine LineSup, "Total des retards supérieurs à 10 000",   SommeSup
    NewLine LineInf, "Total des retards entre 4 000 et 10 000", SommeInf
    NewLine LineRst, "Total des retards inférieurs à 10 000",   SommeRst
End Sub

Je conçois que ce soit plus difficile à écrire. Mais j'estime que c'est très facile à lire.
N'est-ce pas limpide ?
 

fopy12

Habitué
re,

j'ai essayé de faire marcher le"Nouveau code" mais j'ai un message d'erreur : "Incompatibilité de type" au niveau de la ligne 17. j'ai mis un "#" apres les "10000", mais ça ne marche toujours pas. Je suis sous excel 2003.

aussi j'aurai une deuxième question.

comment puis je faire pour que les sous totaux tiennent compte des suppressions de lignes.
je m'explique : une fois mon programme exécuté et que mon tableau tout fini et tout beau :D.
je serais amené à supprimer des lignes.
je me demandais comment faire pour que les sous totaux en tiennent compte?
Merci
 

zeb

Modérateur
Pour ton incompatibilité de type, je suppose que tu essaies d'additionner, ligne 18 en fait, des choux et des carottes. Vérifie si tu n'as pas du texte ou des choses comme ça dans tes lignes :
Code:
For Each cel In Range(ws.Rows(2), LineRst).Columns("H" )
    If Not IsNumeric(cel.Value) Then
        MsgBox "Eh, mec, la cellule " & cel.Address(False, False) & " ne contient pas un nombre"
    Else
        Select Case cel.Value
            Case Is >= 10000
                SommeSup = SommeSup + cel.Value
                LineSup = cel.EntireRow
            Case Is >= 4000
                SommeInf = SommeInf + cel.Value
                LineInf = cel.EntireRow
            Case Else
                SommeRst = SommeRst + cel.Value
        End Select
    Endif
Next

Au lieu de faire des additions, laisse Excel les faire lui même.
Tu connais la fonction =SOMME() d'Excel ? Ben tu peux mettre cette formule dans ta cellule. Ça tombe bien tu as tous les éléments.

(Aide-toi de l'enregistreur de macro pour découvrir comment mettre une formule dans une cellule. Publie ici ton code, je te montrerai comment l'arranger ;) )
 

fopy12

Habitué
Non ya pas de texte, c'est que du chiffre. j'ai même remis le format de ces celules en nombre. Et pourtant ton message apparait bien. j'avoue là je ne comprends pas.
Mais Sinon, voilà ce que l'enregistreur de macro me donne pour ce qui est de mon 2e probleme
Code:
Sub SousTot()
    ActiveCell.FormulaR1C1 = "=SUM(R[-44]C:R[-1]C)"
    Selection.AutoFill Destination:=Range("H46:K46"), Type:=xlFillDefault
    Range("H46:K46").Select
End Sub

Merci de ton aide
 

zeb

Modérateur
Non ya pas de texte, c'est que du chiffre.
Ben par expérience, je peux te dire que c'est bien du texte. Un O pour un zéro, un espace au début, à la fin au milieu... Eh, tu as l'adresse de la cellule, débrouille-toi !

Or donc tu as écris =SOMME() et l'enregistreur a enregistré =SUM(). C'est tout ce que je voulais te faire remarquer. Donc tu supprimes des additions, et tu ajoutes ta formule.

Code:
Sub NewLine(ByRef line_1 As Range, ByRef line_2 As Range, title As String)
    Dim sum_address As String
    
    ' // Juste histoire d'être sûr
    set line_1 = line_1.EntireRow
    set line_2 = line_2.EntireRow
    
    Set sum_address = line_1.Worksheet.Range(line_1, line_2).Columns("H").Address
    
    line_2.EntireRow.Insert
    With line_2.Columns("G")
      .Value = title
      .HorizontalAlignment = xlRight
      .Font.Bold = True
    End With
    With line_2.Columns("H")
      .Formula = "=SUM(" & sum_address & ")"
      .Font.Bold = True
    End With
End Sub
Code:
Sub TrierEtSommeSI()// Nouveau code
    Dim ws         As Worksheets
    Dim cel        As Range
    Dim SommeSup   As Double
    Dim SommeInf   As Double
    Dim SommeRst   As Double   
    Dim LineSup    As Range
    Dim LineInf    As Range
    Dim LineRst    As Range
    
    Set ws = Worksheets("Feuil1")   
    ws.Range("A1" ).Sort Key1:=ws.Columns("H"), order1:=xlDescending, Header:=xlYes
    
    Set LineRst = ws.Cells(ws.Rows.Count, 8).End(xlUp).EntireRow
    For Each cel In Range(ws.Rows(2), LineRst).Columns("H")
        If Not IsNumeric(cel.Value) Then
            MsgBox "Puisque je te dis que la cellule " & cel.Address(False, False) & " ne contient pas un nombre !"
        Else
            Select Case cel.Value
                Case Is >= 10000 : LineSup = cel.EntireRow
                Case Is >=  4000 : LineInf = cel.EntireRow           
            End Select
        End If
    Next
    
    NewLine ws.Rows(2), LineSup, "Total des retards supérieurs à 10 000"
    NewLine LineSup,    LineInf, "Total des retards entre 4 000 et 10 000"
    NewLine LineInf,    LineRst, "Total des retards inférieurs à 10 000"
End Sub

Il y a peut-être deux/trois ajustements à faire ;)
 

fopy12

Habitué
salut Zeb,
je vais te décevoir mais j'ai laché ton code il est hyper compliqué pour moi.
par contre pour ce qui est de mon 2é problème (suppression de ligne et modification de la formule). j'ai essayé d'adapter ce que tu m'avais filé.
et ça marche mais juste pour la dernière ligne. en fait il me fait la somme de la cellule avant la ligne nouvellement insérée.
qu'est ce que je dois mettre pour qu'il prennent en compte, dans le total, tous les nombres supérieurs à 10000? :(

Merci pour ta réponse

Code:
Sub TrierEtSommeSItest()

Worksheets("Feuil1").Range("A1").Sort Key1:=Worksheets("Feuil1").Columns("H"), order1:=xlDescending, Header:=xlGuess

For i = 2 To 10000
    If Range("H" & i).value >= 10000 Then
        SommeSup = SommeSup + Range("H" & i).value
        derniersup = i
        vadresse = Worksheets(1).Range("H" & i).Address
    ElseIf Range("H" & i).value >= 4000 And Range("H" & i).value < 10000 Then
        SommeInf = SommeInf + Range("H" & i).value
        dernierinf = i
    Else
        SommeReste = SommeReste + Range("H" & i).value
    End If
Next

Range("H" & derniersup + 1).EntireRow.Insert
Range("G" & derniersup + 1).value = "Total des retards >= 10 000"
Range("G" & derniersup + 1).Font.Bold = True
Range("G" & derniersup + 1).HorizontalAlignment = xlRight
Range("H" & derniersup + 1).value = SommeSup
Range("H" & derniersup + 1).Formula = "=SUM(" & vadresse & " )"
Range("H" & derniersup + 1).Font.Bold = True

End sub
 

sphynxounet

Habitué
Pour tes lignes est-ce que après ta dernière lignes tu peux avoir d'autres ligne de remplies (en gros avoir une ligne vide) ? Si ce n'est pas le cas tu peux faire un If sur une cellule de ta ligne pur savoir si elle est vide et si c'est le cas sortir du traitement :

[cpp]For i = 1 To 10

If feuil1.cells(i, 1) <> "" Then

...

Else

Exit Sub

End If

Next[/cpp]
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 101
Membres
1 586 287
Dernier membre
lucilleguffey
Partager cette page
Haut