IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Codage de macro [XL-2003]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Inscrit en
    Octobre 2009
    Messages
    127
    Détails du profil
    Informations personnelles :
    Âge : 34

    Informations forums :
    Inscription : Octobre 2009
    Messages : 127
    Par défaut Codage de macro
    Bonjour à tous,

    J'ai utilisé google & la fonction recherche en vain ...

    Je cherche à réaliser une macro qui me permette de modifier du texte dans mon fichier.

    Voici un extrait de mon fichier :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
     
    #31000EQ=#ST3010T+#ST4010T+#ST1110T+#ST1120T+#ST1130T+#ST1140T+#ST1210T+ #ST1220T+#ST1230T+#ST1240T+#ST1150T+#ST1250T
     
    #31000EQST=#ST1300T
    #31000AT=NOINP
    #31000FO=NOINP
    #31000MS=#ST2210T+#ST2011T+#ST2012T+#ST2031T+#ST2032T+#ST2130T+#ST2036T+ &
     #ST2037T+#ST2050T+#ST2120T+#ST2110T+#ST2055T+#ST2021T+#ST2022T+#ST2040T+ &
     #ST2092T+#ST2093T+#ST2013T+#ST2023T+#ST2033T+#ST2038T+#ST2096T
    #31000MSST=#ST2026T+#ST2027T+#ST2094T+#ST2095T+#ST2028T+#ST2097T
    #31000NE=#SN1000T+#SN1010T+#SN1011T+#SN1015T+#SN1016T+#SN1020T+#SN2010T+ &
     #SN3010T+#SN4010T+#SN4020T+#SR1010T+#SR1011T+#SR1020T+#SR1021T+#SR4010T+ &
     #SR4020T
    #31000NEST=NOINP
    Ainsi, à chaque fois que je trouve un " & " en fin de ligne, je veux que la ligne du dessous sois concaténé à celle ou a été trouve le "&" et ainsi de suite.
    Il faut savoir qu'à chaque fois mes données ne sont que dans 1 colonnes. C'est pour moi une manière de traiter mon fichier pour ensuite pouvoir l'intégrer à un autre outils.

    Finalement, ça revient à quelque chose d'apriori pas trop complexe ... Il faudrait une fonction récursive mais là est mon soucis.. Je n'arrive pas à bien la faire.

    De plus, je ne connais pas les propriétés propres au VBA Excel.

    Voici ce que serait à faire dans mon idée mais que je n'arrive pas bien à faire ..

    J'édite mon message lorsque j'arriverai à bien modéliser le code que je souhaite faire car je bug un peu ...

    Merci d'avance,

  2. #2
    Expert confirmé
    Profil pro
    Inscrit en
    Décembre 2007
    Messages
    6 814
    Détails du profil
    Informations personnelles :
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations forums :
    Inscription : Décembre 2007
    Messages : 6 814
    Par défaut
    plusieurs pistes sur le fil suivant : discussion pour faire disparaitre des retours chariots

    Le problème est presque similaire au tien, et les 3 méthodes proposées fonctionnent(même la mienne, qui n'est sans doute pas la meilleure).

  3. #3
    Membre confirmé
    Inscrit en
    Octobre 2009
    Messages
    127
    Détails du profil
    Informations personnelles :
    Âge : 34

    Informations forums :
    Inscription : Octobre 2009
    Messages : 127
    Par défaut
    J'ai donc tenté d'avancé un peu, surement quelques erreurs mais voilà le principe ..

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    Sub modif_mapping()
     
        Dim i, nblignes, premier As Integer
     
        'On compte le nombre de lignes
        nblignes = Range("A6").End(xlDown).Row
     
        'Tant que i<nblignes, on parcours les lignes et on vérifis certaisn choses
        While (i < nblignes)
            'On met la chaine à vide
            chaine = ""
            premier = i
            'On appel la fonction récursive "contient" avec la ligne courante
            i = contient(chaine, i)
            Range("A" & premier).Value = Range("A" & premier).Value + chaine
        Wend
    End Sub
    'Cette fonction aura pour objectif de renvoyer un entier qui sera le nouveau point de départ pour le parcour et de modifier la chaine
    'qui sera ajoutée à la 1ère ligne contenant &
    Function contient(ByRef chaine, ByVal i)
     
        If (Range("A" & i).Value Like "*&") Then
            chaine = chaine + Range("A" & i).Value
            contient(chaine,i)
            i = i + 1
        End If
     
        return i+1
     
    End Function

  4. #4
    Membre confirmé
    Inscrit en
    Octobre 2009
    Messages
    127
    Détails du profil
    Informations personnelles :
    Âge : 34

    Informations forums :
    Inscription : Octobre 2009
    Messages : 127
    Par défaut
    @El_slapper,

    Merci mais je ne comprend pas bien ton code ...

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    Option Explicit
     
    Sub EradicationRetourChariot()
        Dim NumFich1 As Integer, NumFich2 As Integer
        Dim NomFich1 As String, Nomfich2 As String
        Dim Pos1 As Long, Pos2 As Long, Val1 As Integer
        Dim CaractereLu As String * 1
     
        NumFich1 = FreeFile
        NomFich1 = "Z:\export.txt"
        Open NomFich1 For Random As #NumFich1 Len = 1
     
        NumFich2 = FreeFile
        Nomfich2 = "Z:\export2.txt"
        Open Nomfich2 For Random As #NumFich2 Len = 1
     
        Pos1 = 0
        Pos2 = 0
        Do While Not EOF(NumFich1)
            Pos1 = Pos1 + 1
            Get #NumFich1, Pos1, CaractereLu
            Val1 = Asc(CaractereLu)
            If (Val1 <> 10) And (Val1 <> 13) Then
                Pos2 = Pos2 + 1
                Put #2, Pos2, CaractereLu
            End If
        Loop
        Close #NumFich1
        Close #NumFich2
    End Sub
    Je n'ai qu'un fichier mapping.txt,

    Pourquoi en prendre 2 ... ? Je ne comprend pas bien les If (Val1 <> 10) And (Val1 <> 13)

    merci d'avance,

  5. #5
    Membre confirmé
    Inscrit en
    Octobre 2009
    Messages
    127
    Détails du profil
    Informations personnelles :
    Âge : 34

    Informations forums :
    Inscription : Octobre 2009
    Messages : 127
    Par défaut
    Bon bah j'ai réussi de la manière qui suit :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    Sub modif_mapping()
     
    Call supprimer_noinp
    Call concatener
    Call supprimer_noinp
    Call concatener
    Call supprimer_noinp
    Call concatener
    Call supprimer_noinp
    Call concatener
    Call supprimer_noinp
    Call concatener
    Call supprimer_noinp
    Call concatener
     
     
     
    End Sub
     
    Function supprimer_noinp()
        Dim nblignes As Integer
        Dim i As Integer
     
        'On compte le nombre de lignes
        nblignes = Range("A6").End(xlDown).Row
     
        i = 1
     
        'Tant que i<nblignes, on parcours les lignes et on vérifis certaisn choses
        While (i < nblignes)
     
            'On met la chaine à vide
            ra = "A" & i
            ra2 = "A" & i + 1
     
            If (Range(ra).Value Like "*NOINP") Then
                Range(ra).Delete
                nblignes = Range("A6").End(xlDown).Row
            Else
                If (Not Range(ra).Value Like "*#*") Then
                    Range(ra).Delete
                    nblignes = Range("A6").End(xlDown).Row
                End If
     
            End If
     
            i = i + 1
        Wend
     
    End Function
     
    Function concatener()
        Dim nblignes As Integer
        Dim i As Integer
     
        'On compte le nombre de lignes
        nblignes = Range("A6").End(xlDown).Row
     
        i = 1
     
        'Tant que i<nblignes, on parcours les lignes et on vérifis certaisn choses
        While (i < nblignes)
     
     
            ra = "A" & i
            ra2 = "A" & i + 1
     
            While (Range(ra).Value Like "*&")
                Range(ra).Value = Range(ra).Value + Range(ra2).Value
                Range(ra2).Delete
                nblignes = Range("A6").End(xlDown).Row
            Wend
     
            i = i + 1
     
        Wend
     
    End Function
    Merci

  6. #6
    Expert confirmé
    Profil pro
    Inscrit en
    Décembre 2007
    Messages
    6 814
    Détails du profil
    Informations personnelles :
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations forums :
    Inscription : Décembre 2007
    Messages : 6 814
    Par défaut
    Citation Envoyé par DUCKY_ Voir le message
    @El_slapper,

    Merci mais je ne comprend pas bien ton code ...

    (.../...)
    ma philosophie, c'est de traiter caractère par caractère. C'est moche, old school, peu élégant, consommateur de ressources, mais ça marche.(en même temps, les codes élégants aussi...)

    Citation Envoyé par DUCKY_ Voir le message
    Je n'ai qu'un fichier mapping.txt,
    le demandeur n'avait qu'un fichier export.txt. Je ne prends pas 2 fichiers, je prends export.txt, et je créée export2.txt. corrigé suivant ses critères à lui.

    Citation Envoyé par DUCKY_ Voir le message
    Pourquoi en prendre 2 ... ? Je ne comprend pas bien les If (Val1 <> 10) And (Val1 <> 13)

    merci d'avance,
    Val1, c'est la valeur sur la table ascii du caractère lu. Un retour chariot, en général, c'est le caractère 13 suivi du caractère 10(les caractères 1 à 31 ne sont pas vraiment des caractères, ce sont des codes de contrôle). Parfois c'est 13 seul, parfois 10 seul.

    Mon code, il retire tous les retours chariot. Si tu veux l'adapter à ton problème, il te faut mémoriser le caractère lu précédent. du genre(mais à adapter) :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    Sub EradicationRetourChariot()
        Dim NumFich1 As Integer, NumFich2 As Integer
        Dim NomFich1 As String, Nomfich2 As String
        Dim Pos1 As Long, Pos2 As Long, Val1 As Integer
        Dim CaractereLu As String * 1, CaracterePrecedent As String * 1
     
        NumFich1 = FreeFile
        NomFich1 = "Z:\mapping.txt"
        Open NomFich1 For Random As #NumFich1 Len = 1
     
        NumFich2 = FreeFile
        Nomfich2 = "Z:\mappingcorrige.txt"
        Open Nomfich2 For Random As #NumFich2 Len = 1
     
        Pos1 = 0
        Pos2 = 0
        CaracterePrecedent = " "
        Do While Not EOF(NumFich1)
            Pos1 = Pos1 + 1
            Get #NumFich1, Pos1, CaractereLu
            Val1 = Asc(CaractereLu)
            If ((Val1 <> 10) And (Val1 <> 13)) Or CaracterePrecedent <> "&" Then
                Pos2 = Pos2 + 1
                Put #2, Pos2, CaractereLu
                CaracterePrecedent = CaractereLu
            End If
        Loop
        Close #NumFich1
        Close #NumFich2
    End Sub
    en bref, je mémorise le dernier caractère que j'ai réellement écrit, et si c'est un "&", les caractères de retour chariot le suivant sont écartés. J'écris un fichier de sortie mappingcorrige.txt. Je n'ai rien dans mon fichier EXCEL.

    mais ton fichier, il est en .txt, ou tu l'as sous format EXCEL? Dans le premier cas, même pas besoin de l'importer. Dans le deuxième cas, si c'est une seul colonne à modifier, un code plus simple serait :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Sub modif_mapping()
     
        Dim i, nblignes, premier As Integer
     
        'On compte le nombre de lignes
        nblignes = Range("A6").End(xlDown).Row
        i = 6
        'Tant que i<nblignes, on parcours les lignes et on vérifis certaisn choses
        While (i < nblignes)
            If Right(Cells(i, 1), 1) = "&" Then
                Cells(i, 1) = Cells(i, 1) & Cells(i + 1, 1)
                Rows(i + 1).Delete Shift:=xlUp
                nblignes = nblignes - 1
            Else
                i = i + 1
            End If
        Wend
    End Sub
    qui évite une recursivité toujours ennuyeuse à maintenir dans le temps.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Codage pour affectation d"une macro à une image
    Par pelerin98 dans le forum Excel
    Réponses: 5
    Dernier message: 08/05/2015, 09h41
  2. [XL-2010] Problème Codage macro
    Par siouplait dans le forum Excel
    Réponses: 0
    Dernier message: 10/12/2013, 10h48
  3. [XL-2007] Problème de codage dans une macro en VBA
    Par skipeemed dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 23/12/2010, 17h32
  4. Réponses: 4
    Dernier message: 17/03/2009, 19h50
  5. Réponses: 2
    Dernier message: 22/07/2002, 12h13

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo