Suppression espace impossible - données venant d'internet

Oui tu as raison, je n'ai pas été clair : c'est un screen copy d'un site de données (sous forme de table), que je copie tel quel dans excel.

Que veux-tu dire exactement par: "nettoyer ta feuille"?

Avec un Array c'est trop cool : Quand on a essayé on ne peux plus s'en passer !

Crée une deuxième feuille vide et essaie :

Sub Galopin()
Dim Arr
Arr = ThisWorkbook.Worksheets("DATA").Range("A4").CurrentRegion.Value
For i = 2 To UBound(Arr)
   For k = 2 To UBound(Arr, 2)
      Arr(i, k) = REP(Arr(i, k))
   Next
Next
ThisWorkbook.Worksheets(2).Range("A1").Resize(UBound(Arr), UBound(Arr, 2)) = Arr
End Sub
Function REP$(s)
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 REP = t
End Function

A+

Salut @Galopin

Merci pour ton retour... J'avais vraiment pas pensé à utiliser les tab/ array! Donc merci à toi

Pour ton code: il est nettement plus optimisé que le miens Mais par contre, à la 1ere ligne vide il s'arrête, & visiblement la ligne "A1" n'a pas été traitée (il reste les espaces des séparateurs de milliers)

Si j'ai quelques minutes, j'essayerai de modifier ton code pour voir comment je peux l'utiliser... Mais au final, on ne reviendrait pas au miens ?

Bonjour,

Et une autre contribution !?

Cdlt.

Public Sub CleanData()
Dim tbl As Variant, v As Variant
Dim lastCol As Long, lastRow As Long, i As Long, j As Long
Const RW = 2
    With Worksheets("data")
        lastCol = .Cells(RW, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        tbl = .Cells(RW, 1).Resize(lastRow - RW + 1, lastCol).Value
    End With
    For i = 2 To UBound(tbl)
        For j = 2 To UBound(tbl, 2)
            If tbl(i, j) <> "" And Len(tbl(i, j)) > 0 And Not IsDate(tbl(i, j)) Then
                v = VBA.Replace(tbl(i, j), "(", "-")
                v = VBA.Replace(v, ")", "")
                v = VBA.Replace(v, ChrW(8239), "")
                v = VBA.Replace(v, Chr(160), "")
                v = VBA.Replace(v, "%", "")
                tbl(i, j) = CDbl(v)
            End If
        Next j
    Next i
    Worksheets("data").Cells(RW, 1).Resize(lastRow - RW + 1, lastCol).Value = tbl
End Sub

Code impressionnant de rapidité ! Super.
Juste encore un petit souci : il ne nettoie rien au delà de la colonne L voire F à certaines lignes (à partir de 264 par exemple)...

Une idée d'où cela provient ?

Je joins le fichier échantillon, avec le bouton sur l'onglet 2 "TEMP"

3echantillon.xlsm (87.85 Ko)

Bonjour,

Code impressionnant de rapidité ! Super.
Juste encore un petit souci : il ne nettoie rien au delà de la colonne L voire F à certaines lignes (à partir de 264 par exemple)...

Une idée d'où cela provient ?

Ça devait être une version d'évaluation du code. Maintenant il faut prendre un abonnement payant

Bonjour

cela est très simple... dans la partie du code

Const RW = 2
    With Worksheets("data")
        lastCol = .Cells(RW, .Columns.Count).End(xlToLeft).Column

lastcol récupère la dernière colonne occupée.. mais sur la ligne RW... et comme RW est reglé sur 2, cela signifie que le code recherche la dernière colonne occupée sur la ligne 2... donc on récupère la colonne L

par contre Jean-Eric je serais curieux de savoir comment tu savais qu'il fallait utiliser

ChrW(8239)

mais c'est bien ça...

Fred

Bonjour à tous,

@Jean-Eric

        v = VBA.Replace(tbl(i, j), "(", "-")
        v = VBA.Replace(v, ")", "")
        v = VBA.Replace(v, ChrW(8239), "")
        v = VBA.Replace(v, Chr(160), "")
        v = VBA.Replace(v, "%", "")

Y-a-t-il un avantage à écrire VBA.Replace() à la place de Replace() seul ?

Re,

Re,
@Baboutz : en tapant VBA avec un point tu as accès aux fonctions VBA. Replace est une fonction VBA et tu peux donc la sélectionner. Peux-être ignoré, mais peut-être plus rapide !?
@fred2406 : voir Unicode() et Unicar(). Chr(160) n'étant pas le caractère d'espacement pour les valeurs monétaires (teste avec stxt sur une cellule).
@Ayoahha : mets tes différents sur des feuilles différentes !

Cdlt.

Re

@Jean-eric...

Effectivement unicar... me renvoi bien 8239...

J'aurais appris un nouveau truc aujourd'hui...

en fait j'avais utilisé

Debug.Print Asc(Mid(s, i, 1))

pour déterminer le code ascii du caractère... et cela renvoi 160... et il fallait donc utiliser

Debug.Print AscW(Mid(s, i, 1))

qui lui renvoi 8239

Fred

Re,

@Baboutz : en tapant VBA avec un point tu as accès aux fonctions VBA. Replace est une fonction VBA et tu peux donc la sélectionner. Peux-être ignoré, mais peut-être plus rapide !?

Okay ça marche, merci ! Oui peux être, si c'est le cas, ça doit se jouer à pas grand chose...

@Tous

Un grand merci pour votre aide.

Code terminé, avec toutes les réflexions.

Option Explicit

Sub Format_Cliquer()
    Dim tbl As Variant, v As Variant
    Dim lastCol, lastRow, i, j As Long

    Const RW = 2
    'On traite la feuille des données annuelles DATA_A
    With Worksheets("DATA_A")
        lastCol = .Cells(RW, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        tbl = .Cells(RW, 1).Resize(lastRow - RW + 1, lastCol).Value
    End With

    For i = 2 To UBound(tbl)
        For j = 2 To UBound(tbl, 2)
            If tbl(i, j) <> "" And Len(tbl(i, j)) > 0 And Not IsDate(tbl(i, j)) Then
                v = VBA.Replace(tbl(i, j), "(", "-")
                v = VBA.Replace(v, ")", "")
                v = VBA.Replace(v, ChrW(8239), "")
                v = VBA.Replace(v, Chr(160), "")
                v = VBA.Replace(v, "%", "")
                tbl(i, j) = CDbl(v)
            End If
        Next j
    Next i
    Worksheets("DATA_A").Cells(RW, 1).Resize(lastRow - RW + 1, lastCol).Value = tbl

    'On traite la feuille des données trimestrielles DATA_T
    With Worksheets("DATA_T")
        lastCol = .Cells(RW, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        tbl = .Cells(RW, 1).Resize(lastRow - RW + 1, lastCol).Value
    End With

    For i = 2 To UBound(tbl)
        For j = 2 To UBound(tbl, 2)
            If tbl(i, j) <> "" And Len(tbl(i, j)) > 0 And Not IsDate(tbl(i, j)) Then
                v = VBA.Replace(tbl(i, j), "(", "-")
                v = VBA.Replace(v, ")", "")
                v = VBA.Replace(v, ChrW(8239), "")
                v = VBA.Replace(v, Chr(160), "")
                v = VBA.Replace(v, "%", "")
                tbl(i, j) = CDbl(v)
            End If
        Next j
    Next i
    Worksheets("DATA_T").Cells(RW, 1).Resize(lastRow - RW + 1, lastCol).Value = tbl
End Sub

Tout executé en 1sec. Vraiment top.

A+

Re

on pourrait certainement encore optimiser le code en faisant une boucle sur les 2 feuilles au lieu d'écrire 2 fois une grosse partie du code...

Fred

Bonsoir,

A adapter !?

le isDate est peut-être à supprimer...

Cdlt.

Sub Format_Cliquer()
Dim ws As workheet
Dim tbl As Variant, v As Variant
Dim lastCol, lastRow, i, j As Long
Const RW = 2
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        Select Case ws.Name
            Case "Data_A", "Data_T":
                With ws
                    lastCol = .Cells(RW, .Columns.Count).End(xlToLeft).Column
                    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                    tbl = .Cells(RW, 1).Resize(lastRow - RW + 1, lastCol).Value
                End With
                For i = 2 To UBound(tbl)
                    For j = 2 To UBound(tbl, 2)
                        If tbl(i, j) <> "" And Len(tbl(i, j)) > 0 And Not IsDate(tbl(i, j)) Then
                            v = VBA.Replace(tbl(i, j), "(", "-")
                            v = VBA.Replace(v, ")", "")
                            v = VBA.Replace(v, ChrW(8239), "")
                            v = VBA.Replace(v, Chr(160), "")
                            v = VBA.Replace(v, "%", "")
                            tbl(i, j) = CDbl(v)
                        End If
                    Next j
                Next i
                ws.Cells(RW, 1).Resize(lastRow - RW + 1, lastCol).Value = tbl
            Case Else:
        End Select
    Next ws
End Sub

Hello

C'est encore moi. Bon cette fois ci, je me heurte à une incompréhension.

J'ai adapté le dernier code fourni... MAIS, je me retrouve avec des loupés par ci par là !! Impossible de comprendre ce qu'il se passe.

Joint un échantillon du fichier, avec les données. Vous pouvez voir qu'il y a des ratés, certaines valeurs restent avec des "espace".

Avez vous des pistes?

Merci encore

5echantillon.xlsm (57.18 Ko)
Bonjour...

Peut-être ainsi ?
Sub Bouton2_Cliquer()
  Dim ws As Worksheet
  Dim Tb, v As String
  Dim DC As Byte, DL As Long, L As Long, C As Long
    For Each ws In Sheets
      If ws.Name Like "DATA*" Then
        DL = ws.Cells(Rows.Count, 1).End(xlUp).Row
        DC = ws.Cells(2, Columns.Count).End(xlToLeft).Column
        Tb = ws.Cells(2, 1).Resize(DL - 1, DC).Value
        For L = 3 To UBound(Tb)
          For C = 2 To UBound(Tb, 2)
            If Tb(L, C) <> "" And Tb(L, C) <> "CAGR" Then
              If Not IsDate(Tb(L, C)) Then
                v = Replace(Tb(L, C), "(", "-"): v = Replace(v, ")", "")
                v = Replace(v, "%", "")
                v = Replace(v, ChrW(8239), ""): v = Replace(v, Chr(160), "")
                Tb(L, C) = CDbl(v)
              End If
            End If
          Next
        Next
        ws.Cells(2, 1).Resize(DL - 1, DC).Value = Tb
      End If
    Next
End Sub

@Ordonc, code qui a l'air de fonctionner.

Un grand merci. Je reteste.......

Bon je reviens quand même vers vous !

Car il y a toujours des loupés dans la formattage... C'est à n'y rien comprendre

Cela semble être assez aléatoire, même si à priori erreurs détectées colonnes D, E voie F !! (mais pas sur toutes les lignes)?!

Option Explicit

Sub Bouton2_Cliquer()
    Dim ws As Worksheet
    Dim Tb, v As String
    Dim DC As Byte, DL As Long, L As Long, C As Long

    For Each ws In Sheets
        If ws.Name Like "DATA*" Then
            DL = ws.Cells(Rows.Count, 1).End(xlUp).Row
            DC = ws.Cells(2, Columns.Count).End(xlToLeft).Column
            Tb = ws.Cells(2, 1).Resize(DL - 1, DC).Value
            For L = 3 To UBound(Tb)
                For C = 2 To UBound(Tb, 2)
                    If Tb(L, C) <> "" And Tb(L, C) <> "CAGR" Then
                        If Not IsDate(Tb(L, C)) Then
                            v = Replace(Tb(L, C), "(", "-"): v = Replace(v, ")", "")
                            v = Replace(v, " %", "")
                            v = Replace(v, ChrW(8239), ""): v = Replace(v, Chr(160), "")
                            Tb(L, C) = v
                        End If
                    End If
                Next
            Next
            ws.Cells(2, 1).Resize(DL - 1, DC).Value = Tb
        End If
    Next
End Sub

Avec fichier où se trouvent les erreurs, onglet DATA_A surtout.

0echantillon.xlsm (68.64 Ko)
Rechercher des sujets similaires à "suppression espace impossible donnees venant internet"