VBA - Convertir en nombre les nombres stockés sous forme de texte

Le 04/12/2019 à 10:43

Bonjour à tous,

J'effectue un export d'Amazon de notre base de vente et il y a plein de mise en forme à faire pour pouvoir analyser le fichier via TCD.

Comme il y a différentes versions d'export, je dois adapter plusieurs macro.

Là je suis sur notre compte rendu européen et après la mise en forme des informations, les nombres s'affichent en format texte et Excel m'affiche l'erreur avec la possibilité de convertir les cellules en nombre.

Pourriez-vous me dire ce que je dois ajouter dans le code pour que cela le fasse automatiquement ?

Voici le code :

Application.ScreenUpdating = False
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("R:W,AO:AP").Select
    Range("AO1").Activate
    Selection.Replace What:="=", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

J'ai testé plusieurs code mais voilà mes observations :

Premier code : by Galopin01

Sub galopin()
Dim o As Range
On Error Resume Next
For Each o In Selection
If Not o = "" Then o = o * 1
Next
End Sub

Trop long si fichier lourd en informations

Deuxième code : by Jean-Eric aka POWER KIRI

Public Sub Texte_en_Nombre()
Dim c As Range
    Application.ScreenUpdating = False
    For Each c In Range("C2:C" & Range("C2").End(xlDown).Row)
        c = CCur(c)
    Next c
End Sub

J'ai une erreur sur la ligne c=CCur(c) => Non reconnu pas ma version 2016

La range à transformer en nombre : Colonnes - R:W & AO:AP

Je ne peux malheureusement pas fournir de fichier car il y a beaucoup d'informations confidentielles.

J'espère que vous pourrez m'aider avec toutes ces informations.

Je vous remercie de toute l'attention que vous porterez à ma demande.

Le 04/12/2019 à 10:53

Bonjour,

pas difficile de mettre 4-5 lignes anonymisées, ça aurait permis de tester sur ton contenu exact.

Si ton séparateur est la , tu peux tenter :

With [B2:E2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 2)
    .Value = .Value
End With

eric

Edit, sinon :

    Dim datas, lig As Long, col As Long
    datas = [B2:E2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 2).Value
    For lig = 1 To UBound(datas, 1)
        For col = 1 To UBound(datas, 1)
            datas(lig, col) = CDbl(Replace(datas(lig, col).Value, ",", "."))
        Next col
    Next lig
    [B2:E2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 2).Value = datas
Le 04/12/2019 à 10:57
eriiic a écrit :

Bonjour,

pas difficile de mettre 4-5 lignes anonymisées, ça aurait permis de tester sur ton contenu exact.

Si ton séparateur est la , tu peux tenter :

With [B2:E2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 2)
    .Value = .Value
End With

eric

Bonjour eriiic,

Je n'ai rien compris à ton code ^^ désolé. Je suis nul en VBA ne le prends surtout pas comme une critique.

J'essaie de vous créer un fichier avec 4-5 lignes comme demandé.

Merci

Le 04/12/2019 à 10:57

Bonjour,

proposition

Sub test()
   'Range("R:W,AO:AP")
    For col = Asc("R") To Asc("W")
        num (col - 64)
    Next
    For col = Asc("O") To Asc("P")
        num (col - 64 + 26)
    Next
End Sub

Sub num(col%)
    Columns(col).Select
    Selection.TextToColumns Destination:=Cells(1, col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
End Sub

edit : bonjour eriiic

TheAccountant a écrit :

Je ne suis en compétition avec personne. J’essaie seulement d’être meilleur que la personne que j’étais hier.

Le 04/12/2019 à 10:59

Tu peux tester sans chercher à comprendre dans un premier temps.

J'ai complété mon post avec une autre proposition.

eric

Le 04/12/2019 à 11:10
eriiic a écrit :

Tu peux tester sans chercher à comprendre dans un premier temps.

J'ai complété mon post avec une autre proposition.

eric

Voilà le fichier demandé, j'essaie de tester vos propositions.

Merci beaucoup.

J'ai trop envie d'apprendre le VBA et je vous assure que je fais un réel effort pour m'améliorer grâce à vos solutions.

35excel-pratique-power.xlsm (12.77 Ko)
Le 04/12/2019 à 11:21
Steelson a écrit :

Bonjour,

proposition

Sub test()
   'Range("R:W,AO:AP")
    For col = Asc("R") To Asc("W")
        num (col - 64)
    Next
    For col = Asc("O") To Asc("P")
        num (col - 64 + 26)
    Next
End Sub

Sub num(col%)
    Columns(col).Select
    Selection.TextToColumns Destination:=Cells(1, col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
End Sub

edit : bonjour eriiic

TheAccountant a écrit :

Je ne suis en compétition avec personne. J’essaie seulement d’être meilleur que la personne que j’étais hier.

Steelson, je comprends que tu m'as envoyé une proposition sans un fichier test. Je tiens à te remercier pour cela.

J'ai essayé ton code et comme lors de mon export mes informations sont dans la colonne A, il faut que le macro de mise en forme soit en premier.

C'est à dire convertie => Délimité => Virgule et terminer.

Puis viens la mise en forme des nombres, comme cela vient d'amazon.com et les séparateurs sont des "." je fais remplacer les "." par "," mais avant ça il y a une spécificité des exports amazon et je ne sais l'expliquer. Tous les nombres négatifs sont avec des "=" et cela donne l'erreur =CHAMP.

C'est pour cela que je fais d'abord remplacer "=" par "'" puis remplacer les "." par ","

Ta proposition ne tiens pas compte des remplacements.

Encore une fois, merci beaucoup.

Le 04/12/2019 à 11:23

Application de ma proposition

c'est pas du "POWER KIRI"

Sub excel_pratique()
Application.ScreenUpdating = False
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

   'Range("R:W,AO:AP")
    For col = Asc("R") To Asc("W")
        num (col - 64)
    Next
    For col = Asc("O") To Asc("P")
        num (col - 64 + 26)
    Next
Application.ScreenUpdating = True

End Sub

Sub num(col%)
    Columns(col).Select
    Selection.TextToColumns Destination:=Cells(1, col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
End Sub

je laisse eriiic donner aussi d'autres possibilités

46excel-pratique-power.xlsm (16.68 Ko)
Le 04/12/2019 à 11:26
Steelson a écrit :

Application de ma proposition

c'est pas du "POWER KIRI"

Sub excel_pratique()
Application.ScreenUpdating = False
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

   'Range("R:W,AO:AP")
    For col = Asc("R") To Asc("W")
        num (col - 64)
    Next
    For col = Asc("O") To Asc("P")
        num (col - 64 + 26)
    Next
Application.ScreenUpdating = True

End Sub

Sub num(col%)
    Columns(col).Select
    Selection.TextToColumns Destination:=Cells(1, col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
End Sub

je laisse eriiic donner aussi d'autres possibilités

Pourrais-tu me dire si tu remplace les "." par les "," est-ce que t'as une erreur de format nombre stocké sous texte ?

Je te remercie d'avance.

Le 04/12/2019 à 11:29

Non je n'ai pas d'erreur de format a priori (pas d'alerte), non je ne remplace pas les caractères au préalable. Ma version est XL2013 FR. Voici le résultat lu avec ma version ...

capture d ecran 206
Le 04/12/2019 à 11:30

Non tu as raison, il faut que je remplace les . par des virgules au préalable !!

capture d ecran 208
Le 04/12/2019 à 11:33
Steelson a écrit :

Non je n'ai pas d'erreur de format a priori (pas d'alerte), non je ne remplace pas les caractères au préalable. Ma version est XL2013 FR. Voici le résultat lu avec ma version ...

Après le lancement de ta macro, mes chiffres sont avec des "." et non des ","

Le 04/12/2019 à 11:37

En ajoutant le remplacement

Sub excel_pratique()
Application.ScreenUpdating = False
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

   'Range("R:W,AO:AP")
    For col = Asc("R") To Asc("W")
        num (col - 64)
    Next
    For col = Asc("O") To Asc("P")
        num (col - 64 + 26)
    Next
Application.ScreenUpdating = True

End Sub

Sub num(col%)
    With Columns(col)
        .Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        .TextToColumns Destination:=Cells(1, col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    End With
End Sub

Mais attention, ta colonne Q est aussi en numérique alors que tu ne demandais que R:W et AO:AP !!

Le 04/12/2019 à 11:39
TheAccountant a écrit :

Après le lancement de ta macro, mes chiffres sont avec des "." et non des ","

pas chez moi !! .. avec la dernière version tout au moins !

capture d ecran 209
Le 04/12/2019 à 12:02
Steelson a écrit :

En ajoutant le remplacement

Sub excel_pratique()
Application.ScreenUpdating = False
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

   'Range("R:W,AO:AP")
    For col = Asc("R") To Asc("W")
        num (col - 64)
    Next
    For col = Asc("O") To Asc("P")
        num (col - 64 + 26)
    Next
Application.ScreenUpdating = True

End Sub

Sub num(col%)
    With Columns(col)
        .Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        .TextToColumns Destination:=Cells(1, col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    End With
End Sub

Mais attention, ta colonne Q est aussi en numérique alors que tu ne demandais que R:W et AO:AP !!

Merci beaucoup steelson, cela fonctionne à merveille !

J'ai juste rajouter une ligne pour le remplacement des "=" par "" dans les colonnes AO & AP, si tu regarde. Il y a des erreurs #champ si on ne le fait pas.

Voilà le code :

Sub excel_pratique()
Application.ScreenUpdating = False
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

   'Range("R:W,AO:AP")
    For col = Asc("R") To Asc("W")
        num (col - 64)
    Next
    For col = Asc("O") To Asc("P")
        num (col - 64 + 26)
    Next
Application.ScreenUpdating = True

End Sub

Sub num(col%)
    With Columns(col)
        .Replace What:="=", Replacement:="""", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        .Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        .TextToColumns Destination:=Cells(1, col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    End With
End Sub

C'est résolu pour moi car ton code le fait en instantané sur mon setup (pc) et cela veut dire que la macro est efficace et light en même temps. Merci beaucoup !

Merci aussi à eriiic d'avoir essayé de m'aider sans aucun fichier exemple !

Rechercher des sujets similaires à "vba convertir nombre nombres stockes forme texte"