Discussion :

[Progeric]

Bonjour,

J'aimerai savoir s'il est possible de simplifier ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(1, 2).Value = Cells(1, 1).Value & Chr(10) & Cells(2, 1).Value & Cells(3, 1).Value & Chr(10) & Cells(4, 1).Value

Mon problème est que l'ensemble des informations vont de la ligne 1 à 13200 dans la colonne A
cela représente les nom, prénom adresse, code postal et ville de 3000 personnes
et j'aimerai leur envoyer un courrier postal et donc faire un tableau de 3 colonnes sur 1000 lignes (que j'imprimerai sur des étiquettes autocollante...)
le problème vient du fait qu'il n'y a pas le même nombre de ligne pour chaque personne.
Dans la colonne B j'ai écrit une formule de condition que si la cellule de gauche commence par "M. " ou "MME" alors "x"
Cela me donne le début et la fin des cellules que je dois prendre en compte pour fusionner leurs contenu dans mon tableau de 3 sur 1000.

Je sais faire des boucles For Next mais du coup je dois mettre des IF selon le nombre de ligne par personne.

Merci pour votre aide

[Invité]

Bonjour,

Vous pourriez assez facilement recomposer les adresses à partir de la position des codes postaux, une adresse correspondant à l'intervalle entre deux codes + 1 ligne et un code postal correspondant à 5 chiffres.

[Menhir]

J'aimerai savoir s'il est possible de simplifier ce code :

Sans boucle, tu pourrais utiliser la fonction Excel JOINDRE.TEXTE dans VBA.
Elle correspond exactement à ta demande.
Lire ça : https://support.microsoft.com/fr-fr/...3-0e8fc845691c

Pour utiliser une fonction Excel en VBA, tu as deux solutions :
La méthode Evaluate https://docs.microsoft.com/fr-fr/off...ation.evaluate
La propriété WorksheetFunction https://docs.microsoft.com/fr-fr/off...ksheetfunction

Attention, dans les deux cas il faudra utiliser la version anglophone de la fonction.

[Progeric]

Bonjour,

Voici le code que j'utilise, mais je suis sur qu'il peut être simplifier au niveau des boucles avec des commandes wdrarray (ou un truc comme ça)

Merci pour votre aide

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
 
Sub Macro2()
a = 1
b = 4
For x = 1 To 13299
    If Cells(x, 2).Value = "x" Then
        If Cells(x + 4, 2).Value = "x" Then
            y = x + 3
            Cells(a, b).Value = Cells(x, 1).Value & Chr(10) & Cells(x + 1, 1).Value & Chr(10) & Cells(x + 2, 1).Value & Chr(10) & Cells(x + 3, 1).Value
            GoTo suite
        End If
        If Cells(x + 5, 2).Value = "x" Then
            y = x + 4
            Cells(a, b).Value = Cells(x, 1).Value & Chr(10) & Cells(x + 1, 1).Value & Chr(10) & Cells(x + 2, 1).Value & Chr(10) & Cells(x + 3, 1).Value & Chr(10) & Cells(x + 4, 1).Value
            GoTo suite
        End If
        If Cells(x + 6, 2).Value = "x" Then
            y = x + 5
            Cells(a, b).Value = Cells(x, 1).Value & Chr(10) & Cells(x + 1, 1).Value & Chr(10) & Cells(x + 2, 1).Value & Chr(10) & Cells(x + 3, 1).Value & Chr(10) & Cells(x + 4, 1).Value & Chr(10) & Cells(x + 5, 1).Value
            GoTo suite
        End If
        If Cells(x + 7, 2).Value = "x" Then
            y = x + 5
            Cells(a, b).Value = Cells(x, 1).Value & Chr(10) & Cells(x + 1, 1).Value & Chr(10) & Cells(x + 2, 1).Value & Chr(10) & Cells(x + 3, 1).Value & Chr(10) & Cells(x + 4, 1).Value & Chr(10) & Cells(x + 5, 1).Value & Chr(10) & Cells(x + 6, 1).Value
            GoTo suite
        End If
suite:
        b = b + 1
        If b = 7 Then
            b = 4
            a = a + 1
        End If
    End If
Next x
End Sub

[Menhir]

Dans un langage structuré, les Goto, c'est caca-beurk.

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
Sub Macro2()
Dim a As Long, b As Long, x As Long, CC As Long, y As Long
a = 1
b = 4
For x = 1 To 13299
    If Cells(x, 2).Value = "x" Then
        Cells(a, b).Value = Cells(x, 1).Value & Chr(10) & Cells(x + 1, 1).Value & Chr(10) & Cells(x + 2, 1).Value & Chr(10) & Cells(x + 3, 1).Value
        y = x + 2
        For CC = 4 To 6
            If Cells(x + CC, 2).Value <> "x" Then
                Cells(a, b).Value = Cells(a, b).Value & Chr(10) & Cells(x + 1, CC).Value
                y = x + CC - 1
            End If
        Next CC
        b = b + 1
        If b = 7 Then
            b = 4
            a = a + 1
        End If
    End If
Next x
End Sub