Suppression espace impossible - données venant d'internet

Bonjour

Cela fait maintenant plusieurs jours que je tente d'écrire un code VBA afin de transformer des chiffres type US (i.e. avec séparateurs milliers et () pour chiffres négatifs).

Pour ce qui est des chiffres négatifs, aucun problème, il me suffit de remplacer "(" par "-" et supprimer ")".

En revanche, j'ai un gros souci concernant les séparateurs de milliers... Aucune solution testée ne fonctionne:

1- Recherche de " " (et remplacé par "") ne fonctionne pas

2- Utilisation des caractères ASCII pour remplacement (autant 32 que 160), ne fonctionne pas

3- Découpage et recollage de la chaine problématique, en calculant manuellement où se trouve l'espace : je trouve cela franchement très très très très lourd, surtout qu'il y a pas mal de use case à coder... On peut autant avoir des string avec 8, que 13 caractères...

Du coup, je fais appel à vos compétences, car je m'arrache un peu les cheveux sur ce point !!

HELP HELP

Merci à tous ceux qui pourront regarder ce souci

Bonjour

Effectivement un replace du caractère 160 ne fonctionne pas.... pourtant c'est bien le caractère 160 présent pour la séparation des miliers...

Ci joint une petite fonction qui fait le boulot... à tester sur une copie de ton fichier...

Fred

Sub appel()
    Dim Fdata As Worksheet
    Dim plage As range
    Dim Cell As range
    Dim DerLig As Long, NoCol1 As Integer, NoCol2 As Long

    Set Fdata = ThisWorkbook.Worksheets("DATA")

    With Fdata
        Set plage = .range("B4:AQ500")
        For Each Cell In plage
              Cell.Value = Traitechaine(Cell.Value)
        Next
    End With
End Sub
Function Traitechaine(s As String) As String
s = Replace(s, ")", "")
s = Replace(s, "(", "-")
t = ""
For i = 1 To Len(s)
If Asc(Mid(s, i, 1)) <> 160 Then t = t & Mid(s, i, 1)
Next
If t <> "" Then Traitechaine = t
End Function

Bonjour fred,

Du coup un grand merci à toi! Ca fonctionne bien

Bon après ça met un sacré temps... Du coup as-tu une astuce pour accélérer la chose ?

Ou c'est obligatoire d'en passer par là?

Ayo

bonjour,

Worksheets("DATA").range("B4:AQ500").Replace Chr(160),""

A+

Re bonjour

Bonjour Galopin... Ta proposition ne fonctionne pas...

autant on peut l'utiliser pour faire

        plage.Replace "(", "-"
        plage.Replace ")", ""

Mais pour remplacer le caractère 160 cela ne marche pas... et je n'arrive pas a comprendre pourquoi... cela l'efface bien pour les cellules où il y a les pourcentages... mais pas le monétaire..

Voici avec une petite adaptation du code proposer par Galopin..

Sub appel()
Dim Fdata As Worksheet
Dim plage As range
Dim Cell As range
Dim DerLig As Long, NoCol1 As Integer, NoCol2 As Long
deb = Timer
Set Fdata = ThisWorkbook.Worksheets("DATA")

With Fdata
Set plage = .range("B4:AQ500")
plage.Replace "(", "-"
plage.Replace ")", ""
For Each Cell In plage
Cell.Value = Traitechaine(Cell.Value)
Next
End With
MsgBox Timer - deb & "sec"
End Sub
Function Traitechaine(s As String) As String
t = ""
For i = 1 To Len(s)
If Asc(Mid(s, i, 1)) <> 160 Then t = t & Mid(s, i, 1)
Next
If t <> "" Then Traitechaine = t
End Function

Concernant le temps d'exécution du code... sur ma machine cela représente 1,4 sec.... je sais que l'on veut toujours plus rapide.... mais au moins la solution proposée fait le travail demandé...

image

Fred

Bonjour,

Par formule :

=CNUM(SUBSTITUE(B4;UNICAR(8239);""))

Cdlt.

Fred

Merci encore pour ton coup de main.

Sur ma machine en fait, la première version a durée plus de 3h ! Alors certes, avec un peu plus de données, mais pas tant que ça. D'où ma question... En effet car pour 1sec, je n'aurais pas insisté

Mais j'ai lancé la seconde version et on est sur 1min. Donc un grand MERCI Fred pour ton aide.

timer

A bientôt peut être sur d'autres codes

@+

Bon je suis obligé de réouvrir car j'ai nettoyé et relancé de mon outil propre, via donc le bouton dédié sur une feuille!

Du coup, j'y suis toujours depuis 30 minutes... Et pourtant il n'y a pas autant de données à traiter...

Une piste d'après vous?

Option Explicit

Sub TransButton_Cliquer()
    Dim Fdata As Worksheet
    Dim plage As Range
    Dim Cell As Range
    Dim DerLig As Long, NoCol1 As Integer, NoCol2 As Long
    Dim deb As Double

    deb = Timer
    Set Fdata = ThisWorkbook.Worksheets("DATA")

    With Fdata
        Set plage = .Range("B4:AQ500")
        plage.Replace "(", "-"
        plage.Replace ")", ""
        For Each Cell In plage
            Cell.Value = Traitechaine(Cell.Value)
        Next
    End With
    MsgBox "Job done in " & Timer - deb & "sec"
End Sub

Function Traitechaine(s As String) As String
    Dim t As String
    Dim i As Integer
    t = ""

    For i = 1 To Len(s)
        If Asc(Mid(s, i, 1)) <> 160 Then t = t & Mid(s, i, 1)
    Next

    If t <> "" Then Traitechaine = t
End Function

Re bonjour

Une piste d'après vous?

Change de PC

Honnêtement je ne sais pas pourquoi la fonction "Replace" ne fait pas le boulot avec le caractère 160...

par contre il est vrai que sur le fichier test fourni les données ne vont que jusqu'à la colonne L et non AQ... et le nombre de ligne s'arrête à 148 et pas 500....

Ce qui représente déjà 1301 cellules non vide à traiter...

aller encore une petite amélioration...

remplacer la ligne

 Cell.Value = Traitechaine(Cell.Value)

par

             If Cell.Value <> "" Then Cell.Value = Traitechaine(Cell.Value)

et le code va 3 fois plus vite chez moi... soit moins 1/2 seconde...

image

Fred

Re bonjour

Bonjour Galopin... Ta proposition ne fonctionne pas...

Fred

Je répondais à Ayoahha... En principe mes propositions fonctionnent : Sur MAC, je ne sais pas mais sur PC ça ne devrait pas lui poser de problème...

A+

Non ça ne fonctionne pas Galopin

J'avais déjà essayé cela..Désolé

@Galopin

En principe mes propositions fonctionnent : Sur MAC, je ne sais pas mais sur PC ça ne devrait pas lui poser de problème...

A+

Je suis d'accord... mais là il y a un Os... cela marche avec d'autres caractères... et cela fait le boulot aussi pour certains caractères 160 présents entre un chiffre et le %... mais dans un nombre monétaire cela ne marche pas... pourtant c'est bien le caractère ASCII 160 qui est présent comme séparateur des miliers....

j'ai testé ta ligne sur le fichier test fourni sous W10... et cela ne marche pas.. On pourrait se dire que cela ne marche pas car c'est pas le bon caractère .... mais j'ai testé chaque caractère un par un avec debug.print c'est bien le caractère ASCII 160 qui est présent...

je ne comprends pas pourquoi cela ne marche pas.. si tu as une idée... je suis preneur.

Fred

@fred2406

Hehe. Mon PC est pourtant pas mal En fait là ou je tilte, c'est que ça dure vraiment 3h... J'ai arrêté d'ailleurs le dernier

Donc oui, mes données vont jusqu'à AQ (mais sur 25/30 lignes uniquement) et jusqu'à 480 lignes (à peu près, ça varie)

Bon j'ai rajouté le test sur "cellule vide", relancé via le bouton dans le second onglet, et c'est quand même toujours loooooooong... J'en suis pour l'instant à 30min

J'ai l'impression que via le "clic bouton" c'est plus long que via l'exécution direct à l'intérieur de la fonction sur l'outil excel VBA !!

Strange ou pas?

[UPDATE] timing pour version 3 chez moi:

timer 2

Sachant que j'ai des milliers de fichiers à traiter comme celui ci, je suis mal barré !!

Bon de toute façon, déjà au lieu de traiter cellule par cellule, tu dois charger toussa dans un array et traiter ton array :

Normalement ça devrait diviser le temps par 5.

A+

@galopin01
A
s tu voulu rajouter un bout de code dans ton comm (après le ":"), car je ne le vois pas !
Je vais tenter l'affaire en effet avec un array
Pas sûr que je maitrise bien le truc mais je vais regarder

Je regarde aussi un peu plus tard.

Fred

Bonjour,

Sous quel format sont les données issues d'internet ?

Peux-tu joindre l'original ?

Cdlt.

Bon, jai pondu ceci :

Option Explicit

Sub Bouton2_Cliquer()
    'Déclarations
    Dim DerLig, i, j As Integer
    Dim deb As Double, s As String
    Dim tableau() As String
    Dim indexCol()

    'Initialisation
    Application.ScreenUpdating = False
    indexCol = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
    "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ")
    DerLig = Sheets("DATA").Cells(Rows.Count, 1).End(xlUp).Row
    ReDim tableau(DerLig - 2, UBound(indexCol))

    deb = Timer
    Sheets("DATA").Range("B4:AQ500").Replace "(", "-"
    Sheets("DATA").Range("B4:AQ500").Replace ")", ""

    'Enregistrement des valeurs dans le tableau
    For i = 0 To UBound(tableau)
        For j = 0 To UBound(indexCol)
            tableau(i, j) = Sheets("DATA").Range(indexCol(j) & i + 4)
            s = tableau(i, j)
            If s <> "" Then Sheets("DATA").Range(indexCol(j) & i + 4) = Traitechaine(s)
        Next
    Next
    MsgBox "Job done in " & Timer - deb & "sec"
End Sub

Function Traitechaine(s As String) As String
    Dim t As String
    Dim i As Integer
    t = ""

    For i = 1 To Len(s)
        If Asc(Mid(s, i, 1)) <> 160 Then t = t & Mid(s, i, 1)
    Next

    If t <> "" Then Traitechaine = t
End Function

Qui marche très bien. Moins de 1 minutes pour traiter 1 fichier avec près de 1000 cellules non vides.

Si vous avez des optimisations, n'hésitez pas

@Jean-Eric: le xls échantillon est dans le premier message. Je ne sais pas si c'est ta question

Re,

Je doute que ton import soit un xlsm !

Ne serait pas un csv ou un fichier txt, ou encore une copie d'écran ?

Sinon, en VBA, une piste pour arriver au résultat. :

Public Sub Crapdata()
    Application.ScreenUpdating = False
    With ActiveSheet.UsedRange
        .Replace "(", "-"
        .Replace ")", ""
        .Replace ChrW(8239), ""
    End With
End Sub

Il faut nettoyer ta feuille au préalable et travailler uniquement sur les données.

Cdlt.

Rechercher des sujets similaires à "suppression espace impossible donnees venant internet"