Creer une somme automatique avec evitement

[youki]

Bonjour à tous, je suis face à une erreur de programmation de ma part que je n'arrive pas à retrouver.

J'explique, ce script permet de faire la somme de toutes les lignes de "premiereligne" jusqu'a "dernierligne" Seulement la particularité, je désire ne faire la somme que des lignes ou il n'y a pas d'"id" (si la colone A.valeur=vide).

Chaque fois que je ne veux pas qu'une valeur soit sommé je ne mets pas d'idée.

Seulement j'ai deux problèmes que je n'arrive pas à résoudre:
Parfois il saute les cases ou l'id.valeur=vide.
Mais surtout, si j'ai plusieur cases à se suivre sans id cela ne fonctionne pas, j'ai un problème dans les boucles mais je ne vois pas où. Soit il arrete completement la somme à ces lignes et oublie dopnc ainsi certains éléments. Soit il compte quand meme la n-ieme case id.vide ce qui fait une somme fausse.

'--------------------------------------------------
'FONCTION DE TOTAL
'--------------------------------------------------
Sub total(mode As String)

'Numero de départ =  a partir de là ou il faut faire la somme
Dim numeroDeDepart As Long
Dim numeroArret As Long
Dim numeronouvo As Long
Dim haut As Variant
Dim bas As Variant
Dim formule As Variant

'initialisation des variables
bool = True
numeroDeDepart = premiereLigne.Row
numeronouvo = numeroDeDepart
formule = ""

'debut de la boucle sur les colones
For y = 8 To 30
If y = 8 Then
'________________________________________________
 'On Fait le calcul sur une ligne
     For i = 6 To (numeroDerniereLigne - numeroDeDepart)

        'Recherche des cases sans ID
        If premiereLigne.Offset(i, 0) = "" Then
        
            numeroArret = premiereLigne.Offset(i, 0).Row - 1
            'definition de la case de depart pour la somme
            haut = Cells(numeronouvo, y).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            'definition de la case de fin pour la somme
            bas = Cells(numeroArret, y).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            
            If numeronouvo < numeroArret Then
                formule = formule & haut & ":" & bas & ","
                numeronouvo = numeroArret + 2
            End If
            
            'gestion des erreurs si sous total apres finforfait
            While bool = True
                If Range("A" & numeronouvo).Value <> "" Then
                    bool = False
                Else
                    If numeronouvo <= numeroDerniereLigne Then
                        numeronouvo = numeronouvo + 1
                        i = numeronouvo
                    Else
                        bool = False
                    End If
                End If
            Wend
        Else
            numeroArret = i
        End If
        numeroArret = i
    Next i
    'finalisation de la formule de somme
    haut = Cells(numeronouvo, y).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    bas = Cells(numeroDerniereLigne, y).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    
    'si on fini juste apres un total ou un forfait on modifie la formule.(evitement de redondance)
    If (Range("B" & numeroArret + 1).Value) = "___ Fin forfait ___" Or (Range("B" & numeroArret + 1).Value) = "Sous Total" Then
        
        'on vire la dernière virgule
        formule = virgule(formule)
        formule = "= Sum(" & formule & ")"
    Else
        formule = formule & haut & ":" & bas
        formule = "= Sum(" & formule & ")"
    End If
'On insere la formule et on la copie pour la dupliquer sur les autres colones = gain de temps proc (ça se sent!!)
    Cells(numeroDerniereLigne + 1, y).Select
    With Selection
    .Formula = formule
    .Copy
    End With
'________________________________________________
 End If

'Bricolage pour eviter les calculs sur des strings
    If y = 9 Then
        y = 12
    End If
    If y = 17 Then
        y = 19
    End If
    If y = 20 Or y = 21 Then
        y = 22
    End If
    
    Cells(numeroDerniereLigne + 1, y).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Next y
'detection de total ou soustotal
If mode = "final" Then

    Range("B" & numeroDerniereLigne + 1).Value = "TOTAL HT:"
    colone
    Range("A" & numeroDerniereLigne & ":AD" & numeroDerniereLigne).Select
    With Selection.Font
        .Bold = True
        .Size = 12
    End With

    'on fait un jolie cadre autour
    Range("A6:AD" & numeroDerniereLigne).Select
    With Selection.Borders(xlEdgeLeft)
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    'nettoyage du construction_devis
    Range("A" & numeroDerniereLigne + 1 & ":AD" & numeroDerniereLigne + 10).Select
    Selection.Delete Shift:=xlUp
    
ElseIf mode = "inter" Then
'--------------------------------------------------
'FONCTION DE SOUSTOTAL
'--------------------------------------------------
    Range("B" & numeroDerniereLigne + 1).Value = "Sous Total"
    colone
    Range("A" & numeroDerniereLigne & ":AD" & numeroDerniereLigne).Select
    Selection.Font.Bold = True
    Range("A" & numeroDerniereLigne + 1).Select
    
End If
End Sub

Si vous avez une idée

 

[Compte Supprimé 979]

Re : Creer une somme automatique avec evitement

Salut Youki,

Juste comme ça au passage, pourquoi faire ça en VBA !?

Pourquoi ne pas utiliser SOMMEPROD() ou autre !?

A+