[VBA] - Encore et toujours un problème de format

Bonjour,

Dans mon document Excel, j'ai une liste de nombre décimaux qui utilisent un séparateur : "."

Si je fait ctrl+H > Remplacer "." par "," alors le changement est bon.

Si j'utilise le code suivant :

ws9.Range(Cells(2, 1), Cells(lrws9, 10)).Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Il transforme les nombres supérieurs à 1 (1.13331541333055, 11.7992721343471 etc.) en : "113331541333055", "117992721343471", etc.

Vous savez d'où ça vient ?

Ces données sont importées depuis un fichier .csv par la procédure suivante :

Private Sub cmdAlimLesCasesFeuille_Click()

Set ws10 = Worksheets("CSV (ZH)")

lrws10 = ws10.Cells(Rows.Count, 14).End(xlUp).Row
lcws10 = ws10.Cells(1, ws10.Columns.Count).End(xlToLeft).Column
ws10.Range(Cells(1, 1), Cells(lrws10, lcws10)).ClearContents
ws10.Range(Cells(1, 1), Cells(lrws10, lcws10)).Interior.ColorIndex = xlColorIndexNone

    Dim mypath As String
    Dim myfile As String

On Error GoTo Erreur

        Application.FileDialog(msoFileDialogFilePicker).Show
        myfile = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)

    With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & myfile, _
        Destination:=Range("$A$1"))
        .TextFileColumnDataTypes = _
          Array(xlTextFormat, xlTextFormat, xlTextFormat, xlTextFormat, xlTextFormat, _
            xlTextFormat, xlTextFormat, xlTextFormat, xlTextFormat, xlTextFormat, _
            xlTextFormat, xlTextFormat, xlGeneralFormat, xlTextFormat, xlTextFormat) 'xlGeneralFormat 'xlDMYFormat
        .TextFileCommaDelimiter = True
        .TextFilePlatform = 65001
        .TextFileDecimalSeparator = ","
        .Refresh
    End With

Erreur:
    Exit Sub

End Sub

J'utilise xlGeneralFormat pour la colonne qui contient les nombre (colonne 13 dans mon document).

Je joins un document de travail qui illustre bien ce problème.

Même en adaptant le code proposé à l'origine par ric, je n'ai pas su résoudre le souci...

Code ric :

        With ws9
        For Each cL In .Range(Cells(3, 2), Cells(lrws9, 2))
            If cL <> "" Then
                temp = cL
                cursPoint = InStr(1, cL, ".")
                cursVirgule = InStr(1, cL, ",")
                cursPuis = InStr(1, cL, "e")

                'analyse des séparateurs
                If cursPoint > 0 And cursVirgule > 0 Then
                    If cursPoint < cursVirgule Then
                        sepMilier = "."
                        sepDecimal = ","
                    Else
                        sepMilier = ","
                        sepDecimal = "."
                    End If
                Else
                    If cursPoint > 0 Then
                        sepDecimal = "."
                    Else
                        sepDecimal = ","
                    End If
                End If

                'supression séparateur milier
                If sepMilier <> "" Then
                    temp = Replace(temp, sepMilier, Application.ThousandsSeparator)
                End If

                temp = Replace(temp, sepDecimal, Application.DecimalSeparator) ' remplacer le séparateur décimal avec celui de l'application
                cL = CDbl(temp)
                cL = cL / 10                    ' diviser la donnée par 10
                'cL.NumberFormat = "#,##0.00"    ' mettre le format
                cL = cL * 10                    ' multiplier par 10 pour rétablir le data
            End If
        Next cL
    End With

Je vous remercie de votre attention

Bonne journée !

Bonjour

J'ai déja connu cela....

ci joint une proposition de formule qui abouti a ce que tu cherches

Range("C3").ActiveCell.FormulaR1C1 = "=VALUE(LEFT(RC[-1],FIND(""."",RC[-1])-1)&"",""&MID(RC[-1],FIND(""."",RC[-1])+1,50))"

y a plus qu'a recopier vers le bas !

Cordialement

FINDRH

Bonjour,

Merci pour votre proposition.

En effet, sous forme de formule ça fonctionne, il reste plus qu'à faire fonctionner ça sous VBA

Et la gestion des chaînes de caractères sous VBA c'est un peu ma hantise..

Si je passe par un code comme ça :

For a = 3 To lrws9
ws9.Cells(a, 3) = Split(ws9.Cells(a, 2), ".")
ws9.Cells(a, 4) = Mid(ws9.Cells(a, 2), InStrRev(ws9.Cells(a, 2), ".") + 1)

ws9.Cells(a, 2) = ws9.Cells(a, 3) & "," & ws9.Cells(a, 4)
Next a

J'ai exactement la même erreur qui apparaît.

Bonjour

effectivement il y a des pb incompréhensibles

ma formule fonctionne quel est le pb de son utilisation ??

FINDRH

Bonsoir,

La formule que vous proposez fonctionne très bien, mais, pour des raisons pratiques (car tout est automatisé, plusieurs utilisateurs, besoin de réduire le temps d'exécution, etc.) je souhaitais trouver une solution à base de VBA.

En m'inspirant de votre formule et des discussions déjà passées sur ce forum, j'ai pu faire ce code :

    Set ws9 = Worksheets("ZH (Impacts)")
    lrws9 = ws9.Cells(Rows.Count, 1).End(xlUp).Row

ws9.Range(Cells(3, 2), Cells(lrws9, 2)).TextToColumns Destination:=Range("B3"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 2), TrailingMinusNumbers:=True

For a = 3 To lrws9
    ws9.Cells(a, 3) = Split(ws9.Cells(a, 2), ".")
    ws9.Cells(a, 4) = Mid(ws9.Cells(a, 2), InStrRev(ws9.Cells(a, 2), ".") + 1)

    ws9.Cells(a, 2) = ws9.Cells(a, 3) & "," & ws9.Cells(a, 4)
Next a

ws9.Range(Cells(3, 2), Cells(lrws9, 2)).TextToColumns Destination:=Range("B3"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True

ws9.Range(Cells(3, 3), Cells(lrws9, 4)).Delete

Un peu lourd, mais qui s'exécute très rapidement et qui donne le résultat escompté !

Bonne soirée !