Utiliser une fonction permettant de convertir une colonne en plusieur separateur

Question

Bonjour,

Pour faire suite a la premiere discution ouverte (http://www.vbfrance.com/forum/sujet-COMPTER-NOMBRE-OCCURENCE-CARACTERE-DANS-CELLULE_1219550.aspx), j'ouvre une nouvelle discution pour comprendre comment utiliser cette fonction : 

Public Function Count(ByRef vsInput As String, ByRef vsPattern As String, Optional ByVal veCompare As VbCompareMethod =  vbBinaryCompare) As Integer

Dim i As Long,  j As Long 
    i  = InStr(1, vsInput, vsPattern, veCompare)
    j =  1
    Do While i
        Count = Count + 1
        Cells(1, Count).Value = Mid(vsInput, j, i - j)
        j = i + 1
        i = InStr(i + 1, vsInput  & vsPattern , vsPattern, veCompare)

    Loop
    Count  = Count - 1 ' ma boucle fait un cycle de plus que celle de PCPT
End Function

Je souhaite "eclater" la colonne A sur les colonnes A1:Ax.

Merci d'avance,

jbb0306

cs_Orohena · Answer

Bonjour jbb0306 et merci !


Voici un Sub qui "éclate" une variable tstInput dans les cellules A1-A3 de la feuille de calcul en utilisant la fonction Count(). Le caractère séparateur est le point-virgule.



Sub test()
    Dim tstInput As String, tstPattern As String
    tstPattern = ";"    ' separateur
    tstInput = "colonne 1;colonne 2;colonne 3"  ' variable a "eclater"
    Count vsInput:=tstInput, vsPattern:=tstPattern
End Sub

Cordialement

jbb0306 · Answer

Ok merci

Mais en fait je veux mettre dans tstInput toutes les cellules de la colonne A..
Comment puis-je faire ca?

Merci jbb0306

cs_Orohena · Answer

Hello jbb0306

Essaie cette sub. Elle est dérivée des exemples précédents, mais balaie toute la colonne A et s'arrête à la première cellule vide.

Sub chargeCSV()
    Dim wrkLigne As Long
    Dim occurrences() As String
    Dim ptr As Integer
    Const colonne = "A"
    Do
        wrkLigne = wrkLigne + 1
        occurrences = Split(Cells(wrkLigne, colonne), ";")
        For ptr = 0 To UBound(occurrences)
            Cells(wrkLigne, ptr + 1).Value = occurrences(ptr)
        Next
    Loop Until UBound(occurrences) = -1
End Sub

Cordialement

jbb0306 · Answer

Merci beaucoup Orohena

en fait j'ai arrangé le code précédent pour arriver au Sub suivant :

Sub lect_fic_textok()
''
    ChDir "D:" 'chemin du répertoire par default dans la boite "ouvrir un fichier"
    FichierChoisi = Application.GetOpenFilename 'FichierChoisi contient le chemin et le nom du fichier a ouvrir
    
    'Ouverture du fichier choisi avec divers options
    Workbooks.OpenText Filename:=FichierChoisi, Origin:=xlWindows, _
    StartRow:=1, DataType:=xlFixedWidth, TextQualifier:=xlNone, _
    ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 2)
    nbligne = Selection.CurrentRegion.Rows.Count  
    
    'Pour definir l'ensemble de la feuille excel au format Texte, ce qui permet de conserver les "0" a gauche
    Range("A1:BB65536").Select
    Selection.NumberFormat = "@"

    
    Dim tstInput As String, tstPattern As String
    vsPattern = ";"    ' indique le separateur

    For compteur = 1 To nbligne 'Pour chaque ligne faire
        vsInput = Cells(compteur, 1).Value ' variable a "eclater" premiere colonne, ligne ii        i InStr(1, vsInput, vsPattern, veCompare) 'i position du separateur dans la cellule
        j = 1
        cont = 0
        Do While i
            cont = cont + 1
            Cells(compteur, cont).Value = Mid(vsInput, j, i - j)
            j = i + 1
            i = InStr(i + 1, vsInput & vsPattern, vsPattern, veCompare)
        Loop
    cont = cont - 1
    Next
End Sub

Cela me permet de sélectionner un fichier texte par l'ouverture d'un boite de dialogue puis la macro éclate la colonne A en autant de colonnes que de séparateur, tout en conservant les 0 a gauche pour une colonne numero de telephone par exemple.

Si tu voit des choses a améliorer...

Merci,

jbb0306

cs_Orohena · Answer

Bonjour jbb0306

Je vois une amélioration ; je ne sais pas si elle te sera très utile, mais elle peut être intéressante pour d'autres lecteurs.

Ton code formate tous tes champs numériques de ton fichier sans exception comme du texte. Or tu veux peut-être que certains champs restent formatés comme des nombres.

Dans ce cas, le mieux c'est d'initialiser un Array nommé Config() en début de ton Sub. Son contenu donne la configuration de tes colonnes A...n, en précisant pour chaque colonne si elle doit être traitée comme texte (True) ou comme nombre (False).

Donc, plutôt que de formater l'ensemble de ta feuille comme du texte, je suggère de balayer ton tableau Config() en ne formatant comme "Texte" que les colonnes pour lesquelles l'élement correspondant est True.

Concrètement, il faut juste remplacer tes instructions :

Range("A1:BB65536").Select
Selection.NumberFormat = "@"

par quelquechose du genre :

Dim i As Integer
Dim Config() as Boolean
Config = Array(True, True, True, False)
For i = 0 To Ubound(Config)
   If Config(i) Then Columns(i + 1).NumberFormat = "@" ' laisse le format de la colonne 4 en Standard
Next
L'initialisation du tableau Config() ci-dessus indique que la configuration des colonnes est : colonnes 1 à 3 Texte, colonne 4 Standard.

Donc si les colonnes 1 à 3 contiennent un RIB bancaire et la colonne 4 un solde, ce dernier sera au format Standard, tandis que le RIB sera au format Texte, sans suppression des zéros.

Mais la solution ci-dessus présente un grave défaut, que tu as sans doute détecté, et doit donc être améliorée.

En effet, en initialisant l'array Config() par une instruction, comme ci-dessus, la configuration est figée ; seuls les fichiers txt correspondant à cette configuration peuvent être importés. C'est évidemment très gênant si tu dois importer de très nombreux fichiers avec une variété de configurations différentes.

Pour résoudre ce problème, il faut initialiser le tableau Config() non par une instruction, mais dynamiquement à partir d'un fichier texte donnant la liste des fichiers txt avec la configuration de chacun d'entre eux. Supposons que ce fichier de configurations s'appelle Excel.cfg, et ait une seule ligne donnant la configuration du fichier SoldeComptable.txt. Le contenu du fichier Excel.cfg pourrait donc être un truc du genre :
SoldeComptable.txt, True, True, True, False
Dans cette ligne du fichier, la configuration du fichier SoldeComptable.txt est : colonnes 1-3 formatées "Texte",  colonne 4 formatée "Standard".

Pour lire Excel.cfg, extraire la configuration d'un fichier txt, et la charger dans le tableau Config(), il faut, dans le code précédent, remplacer les lignes :

Dim Config() as Boolean
Config = Array(True, True, True, False)

par :

    Dim Config() as Boolean
    Dim fs, f, nf as Integer, strBuf as string, nomFichierChoisi as String
    Dim configFields() As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(fichierchoisi)
    nomFichierChoisi = lCase(f.Name)   ' nom du fichier txt sans chemin et en minuscules (par ex. soldecomptable.txt)
'
' recherche de la configuration de soldeComptable.txt dans Excel.cfg
' Excel.cfg est supposé dans le même repertoire que ce classeur Excel
    nf  = FreeFile
    Open activeWorkbook.path & Application.Path & "Excel.cfg" For Input as nf
    Do
        Line Input #nf, strBuf
    Loop Until EOF(nf) Or Instr(1,lCase(strBuf), nomFichierChoisi) = 1
    Close nf
'
' chargement de la configuration dans le tableau Config()
    If Instr(1,lCase(strBuf), nomFichierChoisi) = 1 Then
         configFields = Split(strBuf, ",")
         Redim Config(Ubound(configFields) - 1)
         For i = 1 to Ubound(configFields)               Config(i - 1) Iif(lCase(configFields) "true", True, False)
         Next
    Else
         MsgBox "Configuration du fichier """ & nomFichierChoisi & """ non trouvé dans Excel.cfg"
         Exit Sub
    End If

Cordialement

jbb0306 · Answer

Effectivement cela peut etre interessant pour d'autres lecteurs mais pour ma part je vais me continuer à tout transformer en texte car je n'ai pas l'utilité de conserver des variables numériques.
Cependant, je viens de me rendre compte qu'il manque le dernier caractère de la dernière cellule a chaque fois...

Utiliser une fonction permettant de convertir une colonne en plusieur separateur

6 réponses

Votre réponse

Discussions similaires