Découpage d'une chaîne contenant de multiples enregistrements en longueur fixe

[STéphane]

Bonjour


je viens de pondre un code qui pourrait être utile à certains.

voilà ce qu'il fait :

Découper la chaîne de longueur fixe de la feuille zone_a_lire
Selon la définition d'un enregistrement de la feuille structure

Et affichage du résultat dans la feuille zone_decryptee


bye
STéphane

 

[Vériland]

Bonsoir STéphane et le forum,

Oui c'est sympa STéphane...c'est pas mal comme principe pour découper une chaîne...par contre il y a des variables qui ne sont pas définies (zone_a_lire par exemple) ce qui pour des novices risque de poser quelques problème lors d'un copier/coller...à moins que tu le souhaitais ainsi !...loool

Enfin c'est pas grave là...c'est le geste qui compte...;-)

 

[STéphane]

bonsoir

c'est vrai que je ne sui spas le roi de la définition.
pour mes besoins personnels, il faudrait d'ailleurs que je puisse gérer différentes définitions de structure et pouvoir choisir celle que je désire.

dans mes tests, j'avais aussi autoriser la sélection d'un fichier et la lecture de la ligne par la méthode open for input


au fait, cela fait longtemps que l'on n'a rien vu dans XLD Goodies
ciao
steph

 

[Jon]

Code nouvellement modifié

j'avaisun problème de dépassement de capacités parceque je n'avais pas défini la variable c de ma boucle en variant heeiiin j'ai cherché longtemps.


j'ai modifié la macro pour mettre un fichier en entrée grâce à une fonction supplémentaire.

vous pouvez créer un fichier contenant la chaine exemple figurant dans le fichier de mon premier message.


par ailleurs, la demande de mon 2nd message tient toujours, si vous avez des suggestions

Sub decoupe_chaine_longueur_fixe()

'Cette macro affiche la valeur des champs des enregistrements figurant dans une seule chaîne de caractères.
'Les champs sont de longueur fixe et il n'existe aucun délimiteur.

Application.ScreenUpdating = False


' ¤¤¤¤¤¤¤¤¤¤ Définition de variables ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Dim r As Integer, Longueur As Integer, Longueur_cumulee As Integer, i As Integer, taille_enregistrement As Integer, nb_champs As Integer, nb_champs_cpt As Integer
Dim zone_a_lire As Worksheet, structure As Worksheet, zone_decryptee As Worksheet
Dim ligne_analysee As String
Dim chaine_a_analyser, c, arr 'variables variantes
Dim toRng As Range

' ¤¤¤¤¤¤¤¤¤¤ Définition de paramètres ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'la variable ci-dessous contient la feuille où figure la structure d'un enregistrement de la chaîne
Set structure = Worksheets("structure")

'la variable ci-dessous (définie comme variante) contient la plage de cellules définissant les champs d'un enregistrement
arr = structure.[A1].CurrentRegion

'la variable ci-dessous contient la feuille où seront affichés les différents enregistrements
Set zone_decryptee = Worksheets("zone_decryptee")

'effacement de la plage de destination
zone_decryptee.[A3].CurrentRegion.ClearContents

'la variable ci-dessous contient la chaîne à analyser
'chaine_a_analyser = zone_a_lire.[A1]

' PASSER VOTRE FICHIER ICI

chaine_a_analyser = File2String("C:\Documents and Settings\steph\monfichier.doc")

'la variable ci-dessous contient la longueur totale d'un champ calculé à partir de leur taille renseignées dans la structure
taille_enregistrement = Application.WorksheetFunction.Sum(structure.Columns(2))

'la variable nb_champs contient le nombre de champs indiqués dans la feuille structure
'calculé en ôtant 1 pour faire extraction des étiquettes de la feuille structure
nb_champs = UBound(arr, 1) - 1

'initialisation de variables utilisées dans des boucles
i = 1


' ¤¤¤¤¤¤¤¤¤¤¤ Début des choses sérieuses ¤¤¤¤¤¤¤¤¤¤¤¤

For c = 1 To Len(chaine_a_analyser) Step taille_enregistrement

'Récupération d'un enregistrement
ligne_analysee = Mid(chaine_a_analyser, c, taille_enregistrement)
'Copie de l'enregistrement lu dans la feuille zone_a_lire
' zone_a_lire.[A1].Offset(i) = ligne_analysee

'initialisation à chaque nouvelle ligne analysée
nb_champs_cpt = 1
Longueur_cumulee = 0

'boucle pour lire la variable tableau alimentée par les cellules définissant la structure
'à partir de la ligne 2 du tableau pour pas prendre la ligne contenant les étiquettes Champ & Longueur
For rw = 2 To UBound(arr, 1)
For cl = 1 To UBound(arr, 2)
' Debug.Print arr(rw, cl)

If cl = 1 Then Champ = arr(rw, cl): zone_decryptee.Cells(3, nb_champs_cpt).Value = Champ

If cl > 1 Then
Longueur = arr(rw, cl)
If Longueur_cumulee = 0 Then Longueur_cumulee = 1
zone_decryptee.Cells(3 + i, nb_champs_cpt).Value = Mid(ligne_analysee, Longueur_cumulee, Longueur)
Longueur_cumulee = Longueur_cumulee + Longueur
End If
Next
nb_champs_cpt = nb_champs_cpt + 1
Next
i = i + 1
Next c
zone_decryptee.Activate: [A1].Select
End Sub


Function File2String(strFile) As Variant
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForReading = 1
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(strFile) Then
Set ts = fs.OpenTextFile(strFile, ForReading, True)
If ts.AtEndOfStream Then
File2String = ""
Else
File2String = ts.ReadAll
End If
ts.Close
Else
File2String = ""
End If
End Function