Distinction virgule - tabulation

Bonjour à tous,

Je tente actuellement de construire une macro permettant de convertir un fichier Excel initial en une seule colonne (voir fichier joint "Original") en un fichier final organisé en colonnes (voir fichier joint "Final").

Mon problème est la distinction entre les virgules liées aux décimales des nombres et les virgules liées aux tabulations. Je ne parviens en effet pas à trouver une astuce, dans la conversion ou dans la macro ultérieure, pour effectuer automatiquement cette distinction. Je peux bien entendu le faire à la main, mais étant donné que nous avons plusieurs milliers de fichiers à traiter, j'aimerais garder une forme de vie sociale dans les mois qui viennent...

Il est à noter que je n'ai pas accès aux fichiers .txt de base.

En vous remerciant par avance,

Pierre Maurage

Bonjour,

Un peu laborieux, mais ça a l'air de marcher sur l'échantillon.

Sub Répartir()
    Dim i&, k%, maxk%, n%, ch
    ch = Split(Worksheets(1).Cells(1, 1), ",")
    With Worksheets(2)
        For k = 0 To UBound(ch)
            .Cells(1, k + 1) = ch(k)
        Next k
        maxk = UBound(ch): i = 2
        Do
            ch = Worksheets(1).Cells(i, 1)
            ch = Left(ch, Len(ch) - 1)
            n = 0
            For k = Len(ch) To 1 Step -1
                If Mid(ch, k, 1) = "," Then
                    If n > 3 Then Mid(ch, k, 1) = "."
                    n = 0
                Else
                    n = n + 1
                End If
            Next k
            ch = Split(ch, ",")
            If UBound(ch) > maxk Then
                Do
                    For k = UBound(ch) To 1 Step -1
                        If InStr(ch(k), ".") = 0 And InStr(ch(k - 1), ".") = 0 Then
                            ch(k - 1) = ch(k - 1) & "." & ch(k)
                            ch(k) = "@"
                            ch = Replace(Join(ch, ","), ",@", "")
                            ch = Split(ch, ",")
                            Exit For
                        End If
                    Next k
                Loop While UBound(ch) > maxk
            End If
            For k = 0 To UBound(ch)
                .Cells(i, k + 1) = ch(k)
            Next k
            i = i + 1
        Loop While Worksheets(1).Cells(i, 1) <> ""
    End With
End Sub

Cordialement

Petit commentaire tout de même :

On procède en 2 temps :

- observation que les suites de nombres supérieures à 3 sont toujours des parties décimales, donc en remontant la chaîne caractère par caractère on remplace les virgules suivies de plus de 3 chiffres par des points (seul séparateur décimal reconnu par VBA).

Ce traitement règle la question pour 22 items sur 39, soit un peu plus de 50%. Pour les autres, un second traitement s'impose.

- lors de la transformation de la chaîne en tableau d'éléments destinés à être affectés chacun à une colonne d'une même ligne, si le nombre d'éléments est supérieur au nombre de colonnes à servir, on remonte chaque élément à partir de la fin, et lorsqu'on trouve 2 valeurs non décimales (sans point), on n'en fait qu'une en les fusionnant en valeur décimale.

On vérifie après élimination de l'élément à supprimer si l'opération doit être renouvelée (ce qui n'était pas le cas pour 16 items sur les 17 à traiter ainsi).

Petite omission de ma part qui n'a pas d'incidence sur cet échantillon, mais pourrait peut-être en avoir : la condition pour compresser le nombre d'éléments :

If InStr(ch(k), ".") = 0 And InStr(ch(k - 1), ".") = 0 Then

devrait être légèrement modifiée :

If ch(k) <> "0" And ch(k - 1) <> "0" And InStr(ch(k), ".") = 0 And InStr(ch(k - 1), ".") = 0 Then

Cordialement

Parfait, magnifique et impressionnant. Merci mille fois pour le travail effectué.

Bien à vous,

Pierre Maurage