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

fopy12

18 Avril 2011 08:36:18

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.

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 !!

Autres pages sur : insertion ligne dernier element condition

| Etre averti des réponses
| Alerter

Répondre à fopy12

fopy12

19 Avril 2011 18:07:11

zeb a dit :

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 : http://www.presence-pc.com/forum/ppc/Programmation/tuto...

salut zeb , voila ce que j'ai réussi à faire gra à ton topic. ça fonctionne.

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

| Alerter

Répondre à fopy12

fopy12

19 Avril 2011 18:07:44

ya surement moyen de l'améliorer!!

| Alerter

Répondre à fopy12

zeb

Expert Programmation

20 Avril 2011 09:49:47

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 ?

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

// 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.

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

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 ?

| Alerter

Répondre à zeb

fopy12

20 Avril 2011 12:33:23

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

.
je serais amené à supprimer des lignes.
je me demandais comment faire pour que les sous totaux en tiennent compte?
Merci

| Alerter

Répondre à fopy12

zeb

Expert Programmation

20 Avril 2011 12:51:21

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 :

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

)

| Alerter

Répondre à zeb

fopy12

20 Avril 2011 14:52:44

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

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

| Alerter

Répondre à fopy12

zeb

Expert Programmation

21 Avril 2011 07:21:29

Citation :

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.

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

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

| Alerter

Répondre à zeb

fopy12

22 Avril 2011 12:56:34

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

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

| Alerter

Répondre à fopy12

sphynxounet

22 Avril 2011 17:50:20

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 :

For i = 1 To 10

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

 
        ...

 
    Else

 
        Exit Sub

 
    End If

 
Next

| Alerter

Répondre à sphynxounet

fopy12

26 Avril 2011 16:47:50

Meilleure réponse sélectionnée par fopy12.

| Alerter

Répondre à fopy12