Une macro pour soustraire

Bonsoir j'ai un fichier xls dans lequel des lignes comportent des valeurs "encadrées" de texte de cette manière "<ele>272.3</ele>", j'aimerai appliquer une soustraction à ces valeurs sans changer le texte qui les encadre, soustraction qui sera toujours le même nombre.

Est il possible de faire une macro qui me faciliterait la tache car j'ai des milliers de lignes a changer.

PS : Je vous ai joint une partie du fichier (pas des milliers de lignes hein ) pour que vous puissiez avoir plus d'information.

Amicalement.

Bonjour,

Procédure à tester.

Cdlt.

Public Sub DEMO()
Dim ws As Worksheet
Dim FinalRow As Long, lSpace As Long
Dim rng As Range, c As Range
Dim FirstAddress As String
Const txt As String = "<ele>"
Const txt2 As String = "</ele>"
Const n As Double = 10  'valeur à soustraire
Dim x

    Application.ScreenUpdating = False

    Set ws = ActiveWorkbook.Worksheets(1)
    FinalRow = ws.UsedRange.Rows.Count
    Set rng = ws.Range("A1").Resize(FinalRow, 1)

    With rng
        Set c = .Find(txt, LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
            FirstAddress = c.Address
            Do
                lSpace = Len(c.Value) - Len(Replace(c.Value, " ", ""))
                x = Replace(Replace(c.Value, txt, ""), txt2, "")
                x = Replace(Val(x) - n, ",", ".")
                c.Value = Space(lSpace) & txt & x & txt2
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With

    Set rng = Nothing: Set ws = Nothing

End Sub

bonjour Xero et Jean-Eric,

Une solution sans vba

Après avoir choisi en D1 la valeur à soustraire, copier la colonne c et coller les valeurs (seulement) sur ton fichier original.

cordialement

ddetp

Bonjour,

Teste ce qui suit. La proc effectue une recherche avec Find et selon la taille de la plage, ça peu prendre un peu de temps car il y a toute une manipulation à faire :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Texte As String
    Dim Nombre As Single
    Dim ValCellule As Single
    Dim NBEspace As String
    Dim Adr As String

    'nombre devant être retranché...
    Nombre = 25

    'la plage est définie en colonne A depuis A1
    With Worksheets("Feuille1")

        Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))

    End With

    'commence la recherche
    Set Cel = Plage.Find("<ele>" & "*", , xlValues)

    If Not Cel Is Nothing Then

        Adr = Cel.Address

        Do

            'récupère le nombre d'espaces qui préfixe
            NBEspace = InStr(Cel.Value, "<") - 1

            'récupère la valeur numérique
            Texte = Replace(Trim(Cel.Value), "<ele>", "")
            Texte = Replace(Texte, "</ele>", "")

            'remplace le point par le séparateur décimal régional
            Texte = Replace(Texte, ".", Format(0, "."))

            'affecte la valeur en Single et effectue la soustraction
            ValCellule = CSng(Texte)
            ValCellule = ValCellule - Nombre

            'puis reconstruit
            Cel.Value = Space(NBEspace) & "<ele>" & Replace(ValCellule, Format(0, "."), ".") & "</ele>"

            Set Cel = Plage.FindNext(Cel)

        Loop While Adr <> Cel.Address

    End If

End Sub

Hervé.

Merci pour vos réponses, je finis mon petit dèj et je vais essayer vos diverses propositions.

MERCI MERCI MERCI

Bonjour,

Merci de tes remerciements.

N"hésite pas pas revenir vers nous pour d'autres questions.

Cdlt.