Sujet Précédent Sujet Suivant

Structurer doc excel

haifas Messages postés 13 Date d'inscription vendredi 1 février 2008 Statut Membre Dernière intervention 17 janvier 2013 - 29 juin 2011 à 10:25
haifas Messages postés 13 Date d'inscription vendredi 1 février 2008 Statut Membre Dernière intervention 17 janvier 2013 - 24 juil. 2011 à 00:40
bonjour,
Je dois structurer un fichier texte en VBA EXCEL,

j'ai un fichier de cette forme:
données en_tête page 1
...........
2015 texte1 texte2 texte3
texte1 texte2 texte3
2145 ; texte1 texte2 texte3
texte1 texte2 texte3
..........
pieds de page
.......
en_tête page2
3012 texte1 texte2 texte3
texte1 texte2 texte3
3013 ; texte1 texte2 texte3
texte1 texte2 texte3
.........
pieds de page2
le texte se trouve dans la colonne A
je veux obtenir cette forme
...........
2015 texte1 texte1 texte2 texte2 texte3_ texte3 données en_tête page 1 pieds de page

2145 texte1 texte1 texte2 texte2 texte3_ texte3 données en_tête page 1 pieds de page

3012 texte1 texte1 texte2 texte2 texte3_ texte3 données en_tête page 2 pieds de page2
3013 texte1 texte1 texte2 texte2 texte3_ texte3 données en_tête page 2 pieds de page2
.........
le numéro dans une cellule ,texte1 texte1 dans la deuxième,texte2 texte2 dans la 3ème et les dernière cellules entête et pieds de page .
j'ai commencé pour un fichier texte avec vb.net j'ai pas eu de résultat , ni même de réponse sur les forums.
donc j'ai changer le travail avec vba excel .
merci pour votre aide

13 réponses

Réponse 1 / 13
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
29 juin 2011 à 21:34
Bonjour,

Regardes la fonction Split (pour séparer les information des lignes)
Ensuite, une boucle devrait fonctionner (en prenant les lignes 2 par 2)

Un truc du genre :
Dim i as Long
i=1
Do while Cells(i,1).value<>""
'Traitements
i=i+2
Loop

Mon site
0
Réponse 2 / 13
haifas Messages postés 13 Date d'inscription vendredi 1 février 2008 Statut Membre Dernière intervention 17 janvier 2013
30 juin 2011 à 09:57
Bonjour,
merci pour votre réponse
mais le fichier peut contenir plus que deux lignes qui doivent être regroupé.
en plus je dois ajouter l'en_tête et pieds de page à la fin pour chaque ligne et chaque page.
0
Réponse 3 / 13
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
30 juin 2011 à 19:49
Bonjour,

Peux-tu mettre un exemple plus complet alors ?

As-tu essayer de coder quelque chose ?

Mon site
0
Réponse 4 / 13
haifas Messages postés 13 Date d'inscription vendredi 1 février 2008 Statut Membre Dernière intervention 17 janvier 2013
1 juil. 2011 à 08:59
Bonjour,
voila le fichier :

[url=http://www.4shared.com/account/dir/4-pj2MNT/_online.html?&rnd=91#dir=11225407]

je dois concaténer l'en_tête jusqu'à MOD TITLE
puis regrouper les ligne appartenant au même numéro et y ajouter l'en_tête et pieds de page.
voila ce que j'ai essayé jusqu'à maintenant:


Public Sub concatener_entete()
Dim en_tête As String
fin = Cells(Rows.Count, "A").End(xlUp).Row
en_tête = ""
Dim i As Integer
i = 1
Do While i <> fin
Do While Left$(Cells(i, 1), 3) <= "---" And Left$(Cells(i, 1), 22) >= "MOD TITLE" And i <> fin
en_tête = en_tête & "|" & Cells(i, 1)
Sheets("concatfeuille").Cells(i, 1) = en_tête
i = i + 1
Loop
j = i + 1

'Do
'i = i + 1
If Left$(Cells(i, 1), 1) "1" Or Left$(Cells(i, 1), 1) "2" Or Left$(Cells(i, 1), 1) = "3" Then
Sheets("concatfeuille").Cells(i, 1).Clear
Sheets("concatfeuille").Cells(i, 1) = (Cells(i, 1)) & en_tête
Else
Sheets("concatfeuille").Cells(i, 1) = (Cells(i - 1, 1)) & Cells(i, 1) & en_tête
End If
' Loop Until i = fin
Loop
End Sub
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 13
haifas Messages postés 13 Date d'inscription vendredi 1 février 2008 Statut Membre Dernière intervention 17 janvier 2013
1 juil. 2011 à 09:05
le lien
http://www.4shared.com/file/jYZ2XguI/test_2.html
0
Réponse 6 / 13
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
2 juil. 2011 à 15:22
Bonjour,

J'ai vu ton fichier, peux-tu mettre un exemple de résultat de la page 1 par exemple ?

Car visiblement ton entête fait plusieurs lignes, comment veux-tu que ces lignes soit assemblées ?

Mon site
0
Réponse 7 / 13
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
2 juil. 2011 à 15:23
Sinon quand tu mets du code sur le forum, merci d(utiliser la coloration syntaxique (3ième icône à partir de la droite).
0
Réponse 8 / 13
haifas Messages postés 13 Date d'inscription vendredi 1 février 2008 Statut Membre Dernière intervention 17 janvier 2013
4 juil. 2011 à 09:03
bonjour,
oui mon l'en_tête fait plusieurs ligne qui doivent être regroupé :
voici un exemple du résultat que je dois avoir :

http://www.4shared.com/file/6BY96FI0/test.html

''dans la feuil2.
0
Réponse 9 / 13
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
4 juil. 2011 à 21:25
Bonjour,

Je n'ai pas le temps de traiter le problème ce soir, j'essayerais de le faire demain (semaine chargée).

Mon site
0
Réponse 10 / 13
haifas Messages postés 13 Date d'inscription vendredi 1 février 2008 Statut Membre Dernière intervention 17 janvier 2013
8 juil. 2011 à 08:32
Bonjour,
merci pour votre aide.
j'ai résolu le problème.
0
Réponse 11 / 13
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
9 juil. 2011 à 14:36
Bonjour,

Voici une proposition (testé sur 2003), à mettre dans un module, appeler la Sub DoTranslation 
Option Explicit

'Type pour mémoriser les données
Private Type tLine
    Key As String
    Data As String
End Type

Public Sub DoTranslation()
    Dim i As Long
    Dim ltDatas() As tLine
    Dim lData As tLine
    
    i = 1
    ReDim ltDatas(-1 To -1)
    
    'Listage des données
    Do
        lData = GetNewData(i)
        If lData.Data <> "" Then
            If UBound(ltDatas) = -1 Then
                ReDim ltDatas(0 To 0)
            Else
                ReDim Preserve ltDatas(0 To UBound(ltDatas) + 1)
            End If
            ltDatas(UBound(ltDatas)) = lData
        End If
    Loop While lData.Data <> ""
    
    TraiteDatas ltDatas
End Sub

Private Function GetNewData(ByRef pLigne As Long) As tLine
    Dim lValue As tLine
    Dim lLine As String
    
    'On récupère une nouvelle donnée
    Do
        lLine = Cells(pLigne, 1).Value
        
        If IsIdLine(lLine) And lValue.Data <> "" Then
            'Ligne identifiée, on sort
            Exit Do
        ElseIf lLine = "" And lValue.Data <> "" Then
            'Plus de données à traiter sur ce jeu, on sort
            Exit Do
        End If
        
        If IsIdLine(lLine) Then
            lValue.Key = Split(lLine, " ")(0)
            lValue.Data = lValue.Data + " " + Mid$(lLine, InStr(lLine, " ") + 1)
        Else
            lValue.Data = Trim$(lValue.Data + " " + lLine)
        End If
        
        pLigne = pLigne + 1
    Loop While (CStr(Cells(pLigne, 1).Value) + Cells(pLigne + 1, 1).Value + Cells(pLigne + 2, 1).Value) <> ""
    
    GetNewData = lValue
End Function

'Ligne d'identification ?
Private Function IsIdLine(ByVal pLigne As String) As Boolean
    If pLigne = "" Then
        IsIdLine = False
    Else
        IsIdLine = IsNumeric(Split(pLigne, " ")(0))
    End If
End Function

'Génération du résultat
Private Sub TraiteDatas(ByRef ptDatas() As tLine)
    Dim i As Long
    
    Dim lLigne As Long
    lLigne = 0
    
    Dim lHeader As Long, lFooter As Long
    lHeader = -1
    
    Worksheets("Feuil3").Activate
    Worksheets("Feuil3").Columns("A").Clear
    
    For i = LBound(ptDatas) To UBound(ptDatas)
        If ptDatas(i).Key = "" Then
            If lHeader <> -1 Then
                GenerateLignes ptDatas, lHeader, i
                lHeader = -1
            End If
        ElseIf lHeader = -1 Then
            lHeader = i - 1
        End If
    Next i
    Worksheets("Feuil1").Activate
End Sub

'Ajout des données dans la Feuil3
Private Sub GenerateLignes(ByRef ptDatas() As tLine, ByVal pHeader As Long, ByVal pFooter As Long)
    Dim i As Long
    Dim lLigne As Long
    
    With Worksheets("Feuil3")
        lLigne = 1
        Do While .Cells(lLigne, 1).Value <> ""
            lLigne = lLigne + 1
        Loop
        
        For i = pHeader + 1 To pFooter - 1
            .Cells(lLigne, 1).Value = ptDatas(i).Key
            .Cells(lLigne, 2).Value = ptDatas(i).Data
            .Cells(lLigne, 3).Value = ptDatas(pHeader).Data
            .Cells(lLigne, 4).Value = ptDatas(pFooter).Data
            lLigne = lLigne + 1
        Next
    End With
End Sub


Mon site
0
Réponse 12 / 13
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
9 juil. 2011 à 14:37
Je n'avais pas vu ta réponse.

Dsl, mais j'ai eu une semaine chargée.

Mon site
0
Réponse 13 / 13
haifas Messages postés 13 Date d'inscription vendredi 1 février 2008 Statut Membre Dernière intervention 17 janvier 2013
24 juil. 2011 à 00:40
Bonsoir,
merci pour votre aide j'essayerai votre code comme même
0

Discussions similaires

EXCEL, faire l'inverse tangente atan pour avoir une valeur en degré minute
wind3813 -
wind3813 -

2 réponses
Calcul sur excel de l'inverse tangente en grade
HERTAN -
ucfoutu -

4 réponses
Les fonctions " racines niemmes " et " arctan "et "arccos " et "arcsin"
labriji -
labriji -

6 réponses
tangente et arctangente
unionx -
unionx -

2 réponses
maudite Arctangente
johan_geii -
johan_geii -

4 réponses
Rejoignez-nous