Microsoft 365 sommes automatiques par dates

[nico833]

Bonjour,

j'ai un fichier excel avec des dates dans la colonne A et des données en colonne C.
Pour la colonne A j'ai réussi à faire en sorte d'intégrer une ligne entre chaque date différentes grâce au code suivant que j'ai trouvé sur le forum.

Sub Essai()
Application.ScreenUpdating = False
Dim Ligne As Long
For Ligne = Range("A65536").End(xlUp).Row To 2 Step -1
If Range("A" & Ligne) <> Range("A" & Ligne - 1) Then
Range("A" & Ligne).EntireRow.Insert
End If
Next
Application.ScreenUpdating = False
End Sub

j'aimerai maintenant additionner les données de la colonne C en ayant un résultat par date (faire la somme par jour), je vous joins un screen de mon fichier en exemple.
Si en plus on peut faire que ça se note en surbrillance ou quelque chose qui permet de rapidement identifier c'est le top.
Vous pouvez m'aider ?

Merci
Nico

 

[vgendron]

Bonjour et bienvenu

pour bien commencer, il faut que tu postes ton fichier en guise d'exemple pour que l'on puisse travailler sur de vraies données qui correspondent réellement à ton fichier de travail

 

[nico833]

le voici

 

[vgendron]

déjà.. il y a un souci..
ton profil indique que tu es en office 365, et tu postes un fichier au format .xls (excel 95 !!)
est ce normal?

 

[nico833]

mince effectivement j'utilise office 365 mais lorsque j'extrais le fichier excel de mon logiciel pro il le sort sur ce format. Je ne sais pas pourquoi

 

[nico833]

mieux en xlsm ?

 

[vgendron]

peut etre une option à selectioner dans ton logiciel.. sinon. pas grave
en PJ ton fichier avec ta macro complétée

 

[nico833]

merci, c'est parfait. Je vais regarder pour le logiciel pro si j'arrive à changer ça.

 

[vgendron]

avec un bout de code en plus pour colorer le mot Total (je n'arrive pas à colorer toute la ligne)
je ne maitrise vraiement pas les MFC

Sub Essai()
Dim Ligne As Long

Application.ScreenUpdating = False
With Sheets("A")
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row

    For Ligne = LastLine To 3 Step -1
        If .Range("A" & Ligne) <> .Range("A" & Ligne - 1) Then
            .Range("A" & Ligne).EntireRow.Insert
        End If
    Next Ligne
    
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    TabData = .Range("A1").Resize(LastLine, 3).Value
    
    For i = LBound(TabData, 1) + 1 To UBound(TabData, 1)
        If TabData(i, 1) = "" Then
            TabData(i, 1) = "Total"
            TabData(i, 3) = Total
            Total = 0
        Else
            Total = Total + TabData(i, 3)
        End If
    Next i
    .Range("A1").Resize(LastLine, 3) = TabData
End With

Range("A2").Resize(LastLine, 3).Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=A2=""Total"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 49407
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.CutCopyMode = False

Application.ScreenUpdating = False
End Sub

 

[Cousinhub]

avec un bout de code en plus pour colorer le mot Total (je n'arrive pas à colorer toute la ligne)
je ne maitrise vraiement pas les MFC

Hello,
@vgendron
en finissant comme cela?

....
....
With Range("A2").Resize(LastLine, 3)
    .FormatConditions.Add Type:=xlExpression, Formula1:="=$A2=""Total"""
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
    End With
End With
Application.ScreenUpdating = False
End Sub

Note l'adressage semi-relatif "$A2"
Bonne apm

 

[vgendron]

Hello @bhbh
effectivement.. c'est beaucoup mieux

 

[nico833]

j'ai dû faire une bêtise quand je clic sur le bouton ça fait 3 fois le total

 

[vgendron]

et bien oui. dans ta macro "color", tu as remis la partie qui insère des lignes et calcule les totaux

 

[nico833]

merci beaucoup

 

[nico833]

Re-bonjour,

le fichier marche super mais j'aimerai rajouter un truc me permettant si possible en 1 clic d'additionner toutes les cellules qui sont en colorées.
Possible de le faire ?

Merci