Problème de VBA

Le 14/10/2025 à 12:59

Bonjour à tous,

J'ai un soucis avec un module, dans ma feuille "Suivi" il me prend bien tous mes codes Analytiques mais je n'arrive pas à avoir les montants je pense que le problème vient de ma formule montant = CleanValue(wsVente.Cells(i, "F").Value) + CleanValue(wsVente.Cells(i, "G").Value)
dict(code)(0) = dict(code)(0) + montant

Je vous transmets mon module complet si une personne peut regarder, ainsi qu'une capture d'écran

Je vous remercie d'avance,

'-------------------------------------------
' Fonction utilitaire (placée en dehors du Sub)
'-------------------------------------------
Function CleanValue(valeur As Variant) As Double
If IsNumeric(valeur) Then
CleanValue = CDbl(valeur)
Else
valeur = Replace(valeur, "€", "")
valeur = Replace(valeur, " ", "")
valeur = Replace(valeur, ",", ".")
If IsNumeric(valeur) Then
CleanValue = CDbl(valeur)
Else
CleanValue = 0
End If
End If
End Function

'-------------------------------------------
' Macro principale
'-------------------------------------------
Sub Synthese_Suivi()

Dim wsVente As Worksheet, wsAchat As Worksheet, wsPointage As Worksheet, wsDeplacement As Worksheet
Dim wsSuivi As Worksheet
Dim dict As Object
Dim i As Long, lastRow As Long
Dim code As String
Dim montant As Double

'--- Feuilles sources et destination ---
Set wsVente = ThisWorkbook.Sheets("Vente")
Set wsAchat = ThisWorkbook.Sheets("Achat")
Set wsPointage = ThisWorkbook.Sheets("Pointage")
Set wsDeplacement = ThisWorkbook.Sheets("Déplacement2")

' Crée ou vide la feuille Suivi
On Error Resume Next
Set wsSuivi = ThisWorkbook.Sheets("Suivi")
If wsSuivi Is Nothing Then
Set wsSuivi = ThisWorkbook.Sheets.Add
wsSuivi.Name = "Suivi"
End If
On Error GoTo 0
wsSuivi.Cells.Clear

'--- Dictionnaire pour stocker les données ---
Set dict = CreateObject("Scripting.Dictionary")

'--- Lecture des feuilles ---
' Vente (colonnes F et G)
lastRow = wsVente.Cells(wsVente.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
code = Trim(wsVente.Cells(i, "A").Value)
If code <> "" Then
If Not dict.exists(code) Then dict.Add code, Array(0, 0, 0, 0)
montant = CleanValue(wsVente.Cells(i, "F").Value) + CleanValue(wsVente.Cells(i, "G").Value)
dict(code)(0) = dict(code)(0) + montant
End If
Next i

' Achat (colonnes F et G)
lastRow = wsAchat.Cells(wsAchat.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
code = Trim(wsAchat.Cells(i, "A").Value)
If code <> "" Then
If Not dict.exists(code) Then dict.Add code, Array(0, 0, 0, 0)
montant = CleanValue(wsAchat.Cells(i, "F").Value) + CleanValue(wsAchat.Cells(i, "G").Value)
dict(code)(1) = dict(code)(1) + montant
End If
Next i

' Pointage (heures en D)
lastRow = wsPointage.Cells(wsPointage.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
code = Trim(wsPointage.Cells(i, "A").Value)
If code <> "" Then
If Not dict.exists(code) Then dict.Add code, Array(0, 0, 0, 0)
montant = CleanValue(wsPointage.Cells(i, "D").Value)
dict(code)(2) = dict(code)(2) + montant
End If
Next i

' Déplacement (colonnes D, F et H)
lastRow = wsDeplacement.Cells(wsDeplacement.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
code = Trim(wsDeplacement.Cells(i, "A").Value)
If code <> "" Then
If Not dict.exists(code) Then dict.Add code, Array(0, 0, 0, 0)
montant = CleanValue(wsDeplacement.Cells(i, "D").Value) + _
CleanValue(wsDeplacement.Cells(i, "F").Value) + _
CleanValue(wsDeplacement.Cells(i, "H").Value)
dict(code)(3) = dict(code)(3) + montant
End If
Next i

'--- Écriture du tableau dans "Suivi" ---
With wsSuivi
.Range("A1:E1").Value = Array("Code analytique", "Vente (€)", "Achat (€)", "Pointage (h)", "Déplacement (€)")
Dim ligne As Long: ligne = 2
Dim key As Variant
For Each key In dict.keys
.Cells(ligne, 1).Value = key
.Cells(ligne, 2).Value = dict(key)(0)
.Cells(ligne, 3).Value = dict(key)(1)
.Cells(ligne, 4).Value = dict(key)(2)
.Cells(ligne, 5).Value = dict(key)(3)
ligne = ligne + 1
Next key

' Totaux
.Cells(ligne, 1).Value = "TOTAL"
.Cells(ligne, 2).Formula = "=SUM(B2:B" & ligne - 1 & ")"
.Cells(ligne, 3).Formula = "=SUM(C2:C" & ligne - 1 & ")"
.Cells(ligne, 4).Formula = "=SUM(D2:D" & ligne - 1 & ")"
.Cells(ligne, 5).Formula = "=SUM(E2:E" & ligne - 1 & ")"

' Mise en forme
With .Range("A1:E" & ligne)
.Columns.AutoFit
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With .Range("A1:E1")
.Font.Bold = True
.Interior.Color = RGB(200, 230, 255)
End With
.Rows(ligne).Font.Bold = True
.Range("B2:C" & ligne - 1).NumberFormat = "#,##0.00 €"
.Range("E2:E" & ligne - 1).NumberFormat = "#,##0.00 €"
.Range("D2:D" & ligne - 1).NumberFormat = "0.0 ""h"""
End With

MsgBox "? Tableau de suivi mis à jour avec succès"

End Sub

capture d ecran 2025 10 14 125702
Le 14/10/2025 à 13:40

Bonjour

Code à tester

Option Explicit

'-------------------------------------------
' Fonction utilitaire (placée en dehors du Sub)
'-------------------------------------------
Function CleanValue(valeur As Variant) As Double
    If IsNumeric(valeur) Then
        CleanValue = CDbl(valeur)
    Else
        valeur = Replace(valeur, "€", "")
        valeur = Replace(valeur, " ", "")
        valeur = Replace(valeur, ",", ".")
        If IsNumeric(valeur) Then
            CleanValue = CDbl(valeur)
        Else
            CleanValue = 0
        End If
    End If
End Function

'-------------------------------------------
' Macro principale
'-------------------------------------------
Sub Synthese_Suivi()

    Dim wsVente As Worksheet, wsAchat As Worksheet, wsPointage As Worksheet, wsDeplacement As Worksheet
    Dim wsSuivi As Worksheet
    Dim dict As Object
    Dim i As Long, lastRow As Long
    Dim code As String
    Dim montant As Variant

    '--- Feuilles sources et destination ---
    Set wsVente = ThisWorkbook.Sheets("Vente")
    Set wsAchat = ThisWorkbook.Sheets("Achat")
    Set wsPointage = ThisWorkbook.Sheets("Pointage")
    Set wsDeplacement = ThisWorkbook.Sheets("Déplacement2")

    ' Crée ou vide la feuille Suivi
    On Error Resume Next
    Set wsSuivi = ThisWorkbook.Sheets("Suivi")
    If wsSuivi Is Nothing Then
        Set wsSuivi = ThisWorkbook.Sheets.Add
        wsSuivi.Name = "Suivi"
    End If
    On Error GoTo 0
    wsSuivi.Cells.Clear

    '--- Dictionnaire pour stocker les données ---
    Set dict = CreateObject("Scripting.Dictionary")

    '--- Lecture des feuilles ---
    ' Vente (colonnes F et G)
    lastRow = wsVente.Cells(wsVente.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        code = Trim(wsVente.Cells(i, "A").Value)
        If code <> "" Then
            If Not dict.exists(code) Then dict.Add code, Array(0, 0, 0, 0)
            montant = CleanValue(wsVente.Cells(i, "F").Value) + CleanValue(wsVente.Cells(i, "G").Value)
            dict(code)(0) = dict(code)(0) + montant
        End If
    Next i

    ' Achat (colonnes F et G)
    lastRow = wsAchat.Cells(wsAchat.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        code = Trim(wsAchat.Cells(i, "A").Value)
        If code <> "" Then
            If Not dict.exists(code) Then dict.Add code, Array(0, 0, 0, 0)
            montant = CleanValue(wsAchat.Cells(i, "F").Value) + CleanValue(wsAchat.Cells(i, "G").Value)
            dict(code)(1) = dict(code)(1) + montant
        End If
    Next i

    ' Pointage (heures en D)
    lastRow = wsPointage.Cells(wsPointage.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        code = Trim(wsPointage.Cells(i, "A").Value)
        If code <> "" Then
            If Not dict.exists(code) Then dict.Add code, Array(0, 0, 0, 0)
            montant = CleanValue(wsPointage.Cells(i, "D").Value)
            dict(code)(2) = dict(code)(2) + montant
        End If
    Next i

    ' Déplacement (colonnes D, F et H)
    lastRow = wsDeplacement.Cells(wsDeplacement.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        code = Trim(wsDeplacement.Cells(i, "A").Value)
        If code <> "" Then
            If Not dict.exists(code) Then dict.Add code, Array(0, 0, 0, 0)
            montant = CleanValue(wsDeplacement.Cells(i, "D").Value) + _
                      CleanValue(wsDeplacement.Cells(i, "F").Value) + _
                      CleanValue(wsDeplacement.Cells(i, "H").Value)
            dict(code)(3) = dict(code)(3) + montant
        End If
    Next i

    '--- Écriture du tableau dans "Suivi" ---
    With wsSuivi
        .Range("A1:E1").Value = Array("Code analytique", "Vente (€)", "Achat (€)", "Pointage (h)", "Déplacement (€)")
        Dim ligne As Long: ligne = 2
        Dim key As Variant
        For Each key In dict.keys
            .Cells(ligne, 1).Value = key
            .Cells(ligne, 2).Value = dict(key)(0)
            .Cells(ligne, 3).Value = dict(key)(1)
            .Cells(ligne, 4).Value = dict(key)(2)
            .Cells(ligne, 5).Value = dict(key)(3)
            ligne = ligne + 1
        Next key

        ' Totaux
        .Cells(ligne, 1).Value = "TOTAL"
        .Cells(ligne, 2).Formula = "=SUM(B2:B" & ligne - 1 & ")"
        .Cells(ligne, 3).Formula = "=SUM(C2:C" & ligne - 1 & ")"
        .Cells(ligne, 4).Formula = "=SUM(D2:D" & ligne - 1 & ")"
        .Cells(ligne, 5).Formula = "=SUM(E2:E" & ligne - 1 & ")"

        ' Mise en forme
        With .Range("A1:E" & ligne)
            .Columns.AutoFit
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        With .Range("A1:E1")
            .Font.Bold = True
            .Interior.Color = RGB(200, 230, 255)
        End With
        .Rows(ligne).Font.Bold = True
        .Range("B2:C" & ligne - 1).NumberFormat = "#,##0.00 €"
        .Range("E2:E" & ligne - 1).NumberFormat = "#,##0.00 €"
        .Range("D2:D" & ligne - 1).NumberFormat = "0.0 ""h"""
    End With

    MsgBox "Tableau de suivi mis à jour avec succès"

End Sub
Le 14/10/2025 à 14:04

Merci beaucoup ça ne marche toujours pas mes montants sont à zéro

Le 14/10/2025 à 14:29

Bonjour,

Comme il est indiqué dans la charte de ce forum, merci de joindre un fichier anonymisé SVP

A+

Rechercher des sujets similaires à "probleme vba"