VBA - Code qui fonctionne une fois sur 2

Bonjour,

Depuis des jours, je pense avoir résolu un problème qui réapparaît systématiquement.

J'ai testé toutes les solutions qui me venaient, mais je ne sais vraiment pas comment m'y prendre.

Dans mon document j'ai des surfaces dans une colonne et l'information qui les décrit dans une autre colonne.

Il est courant que la même information apparaisse plusieurs fois ; j'ai donc demandé à ce qu'il additionne les surfaces à chaque fois que des informations sont identiques.

Exemple :

Culture : 1ha

Culture : 0,2 ha

Culture : 1,7 ha

Culture : 0,3 ha

Boisement : 1,7 ha

Donne ceci :

Culture : 3,2 ha

Boisement : 1,7 ha

Le problème c'est que parfois ça fonctionne et je peux continuer ; parfois il n’additionne pas les surfaces mais les concatène.

Cela vient du fait qu'il stocke les valeur sous forme de texte.

J'ai beau modifié les "." par des "," pour changer le format, ça ne change rien.

Savez-vous d'où ça vient ?

Le code en question :

Option Explicit
Dim ws As Worksheet, ws2 As Worksheet
Dim lrws As Long, lrws2 As Long
Dim x As Integer

Public Sub sumdel2()

Set ws = Worksheets("CSV")
Set ws2 = Worksheets("VNEI (EI)")

'Convertir les données surfaces en nombres (en utilisant la virgule)
lrws = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("AS2:AS" & lrws).Replace what:=".", replacement:=",", LookAt:=xlPart

lrws2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
'Aditionner les surfaces par habitats
For x = lrws2 To 2 Step -1
    If ws2.Cells(x, 2) = ws2.Cells(x - 1, 2) Then
        ws2.Cells(x - 1, 4) = ws2.Cells(x, 4) + ws2.Cells(x - 1, 4)
        ws2.Rows(x).Delete shift:=xlUp
    End If
Next

End Sub

J'ai mis un document en pièce jointe de ce post pour que vous puissiez voir.

Je pense que ça vient du format, mais je ne sais vraiment pas comment me débarrasser de ce problème.

Merci de votre attention.

Bonne journée !

bonjour

en réduisant tes données, tu perds... des données

c'est contraire à une bonne gestion des données

je te propose de faire un simple TCD pour visualiser tes synthèses

amitiés

Bonjour le fil, bonjour le forum,

Tu as oublié la pièce jointe !...

Bonsoir,

Les données sont conservées dans le tableau initial.

Elles sont récupérés pour produire différents tableaux synthétiques, mis en formes et classés toujours de la même manière.

Voilà, cette fois-ci j'ai mis le document en pièce jointe !

Bonjour,

essaie ainsi :

Public Sub sumdel2()
Dim ws As Worksheet, ws2 As Worksheet
Dim lastRow As Long, lRow As Long

    Set ws = Worksheets("CSV")
    Set ws2 = Worksheets("VNEI (EI)")

    'Convertir les données surfaces en nombres (en utilisant la virgule)
    With ws
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(2, 45).Resize(lastRow - 1).Replace what:=".", replacement:=",", LookAt:=xlPart
    End With

    With ws2
        lastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        'Aditionner les surfaces par habitats
        For lRow = lastRow To 2 Step -1
            If .Cells(lRow, 2) = .Cells(lRow - 1, 2) Then
                .Cells(lRow - 1, 4) = CDbl(.Cells(lRow, 4)) + CDbl(.Cells(lRow - 1, 4))
                .Rows(lRow).Delete shift:=xlUp
            End If
        Next
    End With

End Sub

Bonjour à tous,

@Jean-Eric ... Vignoble n'a qu'une ligne, la condition d'addition ne se fait pas, la donnée reste donc en text Vignoble 0,31075 alignée à gauche.

ric

@Jean-Eric ... Vignoble n'a qu'une ligne, la condition d'addition ne se fait pas, la donnée reste donc en text Vignoble 0,31075 alignée à gauche.

En effet.

Pour la suite j'utilise ce code :

ws2.Range(Cells(2, 4), Cells(lrws2, 4)).NumberFormat = "#,##0.00"" ha"""

Et toutes les valeurs se retrouvent avec la mention "ha" après le nombre, sauf la ligne Vignoble.

Bonjour à tous,

Désolé, je n'ai regardé que le code sans tenir compte de l'ensemble.

Mille excuses ...

ric

Re,

Il suffit avant tout de convertir les valeurs texte de la colonne SURFHA (45) en valeurs numériques avec la méthode TextToColumns.

Cdlt.

Bonjour,

Dans le code qui me permet d'importer les données, j'ai ajouté la conversion des données de surfaces comme vous le conseilliez, ainsi :

    With ws
        'dernière ligne non vide de la colonne AH (34)
        N = .Cells(.Rows.Count, 34).End(xlUp).Row   'AH
        'plage à copier sans l'en-tête de colonne
        Set rng = .Cells(2, 34).Resize(N)
        Set rng2 = .Cells(2, 45).Resize(N)
    End With

    With ws2
        'dernière ligne non vide de la colonne B (2)
        n2 = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
        'cellule de destination de la copie de rng
        Set Cell = .Cells(n2, 2)
        Set Cell2 = .Cells(n2, 4)
    End With

    rng.Copy Destination:=Cell
    rng2.Copy Destination:=Cell2

    With ws2
        'dernière ligne non vide de la colonne B (2)
        n2 = .Cells(.Rows.Count, 2).End(xlUp).Row   'B
        'plage de cellules avec en-tête pour supprimer les doublons
        Set rng = .Cells(2, 2).Resize(n2)
        Set rng2 = .Cells(2, 4).Resize(n2)
        rng2.TextToColumns Destination:=rng2, DataType:=xlDelimited
    End With

Via cette ligne : rng2.TextToColumns Destination:=rng2, DataType:=xlDelimited

A priori, ça fonctionne bien, j'ai testé et j'ai bien les résultats souhaités.

Merci de votre aide !

Bonne journée