Aide macro excel

Version imprimable

13/06/2012, 14h02
gregtw29

1 pièce(s) jointe(s)

Aide macro excel

Bonjour,

J'ai un fichier excel contenant les données suivantes sur les casinos en France:
http://img443.imageshack.us/img443/8766/sanstitreic.png

J'ai donc trois colonnes: Commune, casino, societe

Je voudrais avoir un fichier excel sous cette forme: Commune, casino, adresse, code_postal, ville, complement_adresse, societe

Comme vous pouvez le voir le soucis est que certains casinos ont 4 lignes au lieu de trois pour la colonne Casino.

Je voulais donc savoir si c'était possible de faire une macro pour automatiser ce traitement, et si vous n'auriez pas un tuto ou des noms de commandes à me donner pour que je recherche des détails car pour le moment je ne trouve rien.
13/06/2012, 14h30
ZebreLoup

On peut le faire assez facilement, mais il faudrait une règle de traitement spécifique vu que le nombre de lignes peut varier. Peut-être que par exemple, on est sûr que la dernière ligne est toujours Code Postal + Ville et la première Nom du casino. Sinon, ce sera comme de jouer à la roulette (désolé, mais je n'ai pas pu me retenir)

Pour commencer, on peut isoler facilement le code postal.
Ici, ce champ a 3 propriétés:

il est composé uniquement de chiffres
il est composé de 5 caractères
il se situe en "fin de cellule"

on peut donc faire un double filtre:

on prélève tous les chiffres présents dans une cellule
on filtre pour ne garder que les 5 derniers chiffres

cf code ci-dessous, assez sale, mais facilement intégrable

Code:

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
Sub trouve_isole_code_postal()
 
Dim c As Range
Dim i As Integer, x As String, n As String
b = 1
 
Sheets("Feuil1").Select 'Sélection de la feuille contenant les données sources
Range("A1:A100").Select 'Sélection de la colonne des adresses
 
'Prélève les chiffres et les copie sur la même colonne mais en feuille 2
For Each c In Selection
    For i = 1 To Len(c)
        x = Mid(c, i, 1)
        If IsNumeric(x) Then n = n & x
    Next i
    If n <> "" Then
        Sheets("Feuil2").Range("A" & b).Value = n
        n = ""
        b = b + 1
    End If
 
Next c
 
'Pointe sur la feuille 2 et prélève les 5 derniers chiffres de la colonne nouvellement créée (un code postal a toujours 5 chiffres
Sheets("Feuil2").Select
 
'Ecrit le code postale dans la colonne juste à côté
For i = 1 To 100
    Cells(i, 2) = Right(Cells(i, 1), 3)
Next i
 
End Sub

13/06/2012, 15h03
pc75

1 pièce(s) jointe(s)

Bonjour,

Je me suis "amusé" à bricoler un petit truc.

Il y a certainement des adaptations à faire.

Voici ce que j'ai fait de mon coté

Code:

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
Option Explicit
 
Public Sub TransformeListeCasino()
 
    Dim ws1 As Worksheet, ws2 As Worksheet
 
    Dim commune As String
    Dim casino As String
    Dim adresse As String
    Dim codePostal As Long
    Dim ville As String
    Dim complementAdresse As String
    Dim societe As String
 
    Dim i1, i2 As Integer
    Dim maxRow As Integer
    Dim row2 As Integer
 
    Set ws1 = Worksheets("FeuilleOriginale")
    Set ws2 = Worksheets("FeuilleDestination")
 
    maxRow = ws1.Range("B65000").End(xlUp).Row
 
    i1 = 2
    row2 = 2
    commune = ws1.Cells(i1, 1).Value
 
    Do While commune <> ""
        'On cherche la ligne de la commune suivante
        i2 = i1 + 1
        Do While ws1.Cells(i2, 1).Value = "" And i2 <= maxRow
            i2 = i2 + 1
        Loop
 
        societe = ws1.Cells(i1, 3).Value
        casino = ws1.Cells(i1, 2).Value
        adresse = ws1.Cells(i2 - 2, 2).Value
        codePostal = Left(ws1.Cells(i2 - 1, 2).Value, 5)
        ville = Right(ws1.Cells(i2 - 1, 2).Value, Len(ws1.Cells(i2 - 1, 2).Value) - 6)
        complementAdresse = IIf(i2 - i1 >= 4, ws1.Cells(i2 - 3, 2).Value, "")
 
        ws2.Cells(row2, 1).Value = commune
        ws2.Cells(row2, 2).Value = casino
        ws2.Cells(row2, 3).Value = adresse
        ws2.Cells(row2, 4).Value = codePostal
        ws2.Cells(row2, 5).Value = ville
        ws2.Cells(row2, 6).Value = complementAdresse
        ws2.Cells(row2, 7).Value = societe
        row2 = row2 + 1
 
        i1 = i2
        commune = ws1.Cells(i1, 1).Value
    Loop
 
End Sub

@l'Albatros : Je n'ai pas bien compris ce que tu essayais de faire dans ton code, mais juste une remarque : On essaie régulièrement de sensibiliser les débutants pour qu'ils évitent au maximum les Select ou Activate dans leur code (vraiment une grosse source d'erreurs et de ralentissements potentiels), alors il serait surement mieux d'essayer de leur proposer du code sans ça.

Je précise que mon code part du principe que les données de la colonne B sont sur plusieurs lignes et que les cellules des colonnes A et C sont fusionnées, ce qui me semblait être le cas dans la capture d'écran, d'où la différence avec les autres codes.

13/06/2012, 15h23
gregtw29

Merci de votre aide.

@L'Albatros: Je vais tester ton script.

@pc75: As tu mis ta macro das ton fichier xls?
Je ne la vois pas.
13/06/2012, 15h25
pc75

Citation:

Envoyé par gregtw29

Merci de votre aide.

@L'Albatros: Je vais tester ton script.

@pc75: As tu mis ta macro das ton fichier xls?
Je ne la vois pas.

Elles sont dans l'éditeur Visual Basic ; ce sont des fonctions personnalisées.

Oui c'est exactement cela qu'il me faut.

J'ai vu les codes dans l'éditeur VB:

Code:

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
Function Casino(Origine As String) As String
    For i = 1 To Len(Origine)
        If Asc(Mid(Origine, i, 1)) = 10 Then
            Casino = Left(Origine, i - 1)
            Exit For
        End If
    Next
End Function
 
Function Postal(Origine As String) As String
    For i = Len(Origine) - 2 To 1 Step -1
        If Asc(Mid(Origine, i, 1)) >= 48 And Asc(Mid(Origine, i, 1)) <= 57 Then
            Postal = Mid(Origine, i - 4, 5)
            Exit For
        End If
    Next
End Function
 
Function Adresses(Origine As String) As String
    For i = 1 To Len(Origine)
        If Asc(Mid(Origine, i, 1)) = 10 Then
            DebAdresse = i + 1
            Chaine = Mid(Origine, i + 1)
            Exit For
        End If
    Next
 
    For i = Len(Chaine) - 2 To 1 Step -1
        If Asc(Mid(Chaine, i, 1)) >= 48 And Asc(Mid(Chaine, i, 1)) <= 57 Then
            FinAdresse = i - 6
            Adresses = Mid(Chaine, 1, i - 6)
            Exit For
        End If
    Next
End Function
 
Function Ville(Origine As String) As String
    For i = Len(Origine) - 2 To 1 Step -1
        If Asc(Mid(Origine, i, 1)) >= 48 And Asc(Mid(Origine, i, 1)) <= 57 Then
            Ville = Mid(Origine, i + 2)
            Exit For
        End If
    Next
End Function

Du coup je créé la macro "tri", ce qui me créé:

Code:

1
2
3
Sub tri()
 
End Sub

Que faudrait-il mettre dans le main pour que ça me donne les résultats que tu as obtenu?
Désolé mais je débute dans les macro, je capte ton code mais je ne sais pas comment appeler les fonction dans mon main.

13/06/2012, 15h38
ZebreLoup

Attention, le code de pc75 marche très bien si les différentes lignes viennent d'un passage à la ligne dans une cellule (via Alt+Enter par exemple). Vérifie donc ce point avant de partir sur sa solution ou sur la mienne. (Ta copie d'écran laissait entrevoir des bordures et donc des cellules différentes)
13/06/2012, 16h01
gregtw29

En effet.

J'ai testé ton code mais j'ai l'erreur suivante:

Citation:

Erreur d’exécution '9':
L'indice n'appartient pas à la sélection.

J'ai rajouté mon excel en fichier joint dans mon premier message si ça peut vous aider.
13/06/2012, 16h18
pc75

Citation:

Envoyé par gregtw29

Que faudrait-il mettre dans le main pour que ça me donne les résultats que tu as obtenu?
Désolé mais je débute dans les macro, je capte ton code mais je ne sais pas comment appeler les fonction dans mon main.

Dans une cellule vide tu fais insertion => fonction personnalisée et tu choisis la fonction "Casino" que tu fais pointer sur la cellule initiale.
Tu répètes la même chose sur d'autres cellules vides pour les autres fonctions.
Enfin, tu étires les formules vers le bas.

Edit : Désolé, je n'avais pas vu que chaque ligne correspondait à une cellule. Donc mon truc ne peut pas fonctionner.
13/06/2012, 16h39
gregtw29

1 pièce(s) jointe(s)

Si j'ai reussis à mettre les 3 ou 4 infos dans une même cellule avec Calc de Libreoffice, et j'ai bien un xls comme il faut pour ta macro.

Seulement même sur ton fichier adresse.xls je n'arrive pas à relancer ta macro.

Je l'ai bien dans l'éditeur Visual Basic.
Je clique donc sur la flèche verte et je l'enregistre sous le nom "casinos".

Cependant quand je clique sur une cellule vide je ne vois pas le lien "insertion => fonction personnalisée"

EDIT: J'ai trouvé.

As-tu modifié le nom des feuilles dans le code que je t'ai fourni ? J'avais mis n'importe quoi car je ne pouvais pas deviner comment était ton fichier.

Voici le code modifié adapté à ton fichier casinos.xls. J'ai fait quelques modifs pour prendre en compte les cas où il y avait des lignes vides dans la colonne B. J'ai aussi rajouter manuellement les noms des colonnes sur la première ligne de Feuil2

Code:

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
Option Explicit
 
Public Sub TransformeListeCasino()
 
    Dim ws1 As Worksheet, ws2 As Worksheet
 
    Dim commune As String
    Dim casino As String
    Dim adresse As String
    Dim codePostal As String
    Dim ville As String
    Dim complementAdresse As String
    Dim societe As String
 
    Dim i1 As Integer, i2 As Integer
    Dim j1 As Integer, j2 As Integer
    Dim maxRow As Integer
    Dim row2 As Integer
 
    Set ws1 = Worksheets("Feuil1")
    Set ws2 = Worksheets("Feuil2")
 
    maxRow = ws1.Range("B65000").End(xlUp).Row
    ws2.Range("A2:G65000").ClearContents
 
    i1 = 2
    row2 = 2
    commune = ws1.Cells(i1, 1).Value
 
    Do While commune <> ""
        'On cherche la ligne de la commune suivante
        i2 = i1 + 1
        Do While ws1.Cells(i2, 1).Value = "" And i2 <= maxRow
            i2 = i2 + 1
        Loop
 
        'On cherche la première ligne non vide en colonne B
        j1 = i1
        Do While ws1.Cells(j1, 2).Value = ""
            j1 = j1 + 1
        Loop
        'On cherche la dernière ligne non vide en colonne B
        j2 = i2 - 1
        Do While ws1.Cells(j2, 2).Value = ""
            j2 = j2 - 1
        Loop
 
        societe = ws1.Cells(i1, 3).Value
 
        casino = ws1.Cells(j1, 2).Value
        adresse = ws1.Cells(j2 - 1, 2).Value
        codePostal = ws1.Cells(j2, 2).Value
        If Len(codePostal) > 6 Then
            ville = Right(codePostal, Len(codePostal) - 6)
        Else
            ville = ""
        End If
        codePostal = Left(codePostal, 5)
        complementAdresse = IIf(j2 - j1 >= 3, ws1.Cells(j2 - 2, 2).Value, "")
 
        ws2.Cells(row2, 1).Value = commune
        ws2.Cells(row2, 2).Value = casino
        ws2.Cells(row2, 3).Value = adresse
        ws2.Cells(row2, 4).Value = codePostal
        ws2.Cells(row2, 5).Value = ville
        ws2.Cells(row2, 6).Value = complementAdresse
        ws2.Cells(row2, 7).Value = societe
        row2 = row2 + 1
 
        i1 = i2
        commune = ws1.Cells(i1, 1).Value
    Loop
 
End Sub

13/06/2012, 17h00
gregtw29

Oui la première erreur était du à cela.

Mais après il y 'en a d'autres:

Incompatibilité de type:

Code:

codePostal = Left(ws1.Cells(i2 - 1, 2).Value, 5)

Erreur définie par l'application ou par l'objet:

Code:

complementAdresse = IIf(i2 - i1 >= 4, ws1.Cells(i2 - 3, 2).Value, "")

EDIT: ton dernier script marche bien.
Il y a quelques erreurs pour le code postal mais je vais regler cela.
Maintenant que ça fonctionne je peux me plonger dans la modification.

Thanks.
13/06/2012, 17h04
ZebreLoup

Dans le dernier code j'ai modifié codePostal en String pour ne pas avoir l'erreur en cas de problème, mais de toute façon, ce n'était plus le cas car c'était à cause du décalage du aux cellules vides.
13/06/2012, 17h05
gregtw29

Oui merci, il y a juste quelques codes postaux qui sont en adresse mais je vais régler le soucis.
13/06/2012, 17h11
ZebreLoup

Oui, je n'avais pas vu que certaines cellules de la colonne A n'étaient pas fusionnées, peut-être en cherchant i1 et i2 via la colonne C du coup si il n'y a pas de souci du fusion sur cette colonne (et en modifiant un peu pour prendre les deuxièmes lignes de A quand il y en a).

Mais bon, VBA n'est pas un être intelligent et ne peut pas deviner tout seul, donc s'il n'y a pas une certaine logique dans les données initiales, c'est impossible de prévoir tous les cas (disons que l'on passerait plus de temps à programmer tous les cas qu'à faire les choses manuellement)

En modifiant la ligne 33

Code:

Do While ws1.Cells(i2, 1).Value = "" And i2 <= maxRow

par

Code:

Do While ws1.Cells(i2, 3).Value = "" And i2 <= maxRow

Ça a l'air de marcher. Il reste à ajouter les régions entre parenthèses quand il y en a et il y a toujours les cas où l'ordre de l'adresse et du complément d'adresse sont inversés.