Discussion :

[SectoSSD]

Bonjour à tous,

D'un coté j'ai un fichier adresse (10 à 50k ligne) qui vient de l'extérieur et de l'autre un répertoire qui permet de rapporter à des adresses un secteur (1,5k ligne).




Je fais une macro pour rapporter à chaque adresse du fichier adresse son secteur en colonne H. Pour cela il faut prendre en compte la commune, la voie et le numéro de voie.

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
Sub recherchex()
Dim rep_d(), adr, rep, dico, i&, j&, nbl_r&, nbl_a&, temp, adr_b(), k%, rep_nbmot%, adr_nbmot%
nbl_a = Range("C2").End(xlDown).Row
nbl_r = Range("O3").End(xlDown).Row
ReDim adr(nbl_a), adr_b(nbl_a), rep(nbl_r), rep_b(nbl_r)
adr = Range("C2:G" & nbl_a).Value
rep = Range("O3:V" & nbl_r).Value
ReDim adr_b(nbl_a)
ReDim Preserve adr(LBound(adr) To UBound(adr), 1 To 5)
For j = LBound(adr) To UBound(adr)
For k = LBound(rep) To UBound(rep)
adr_b(j) = adr(j, 3)
rep_nbmot = UBound(Split(rep(k, 4))) + 1
adr_nbmot = UBound(Split(adr_b(j))) + 1
If Not IsEmpty(Range("H" & j)) Or k = UBound(rep) Then '(A : si déjà rempli ou repertoire finit)
Exit For
ElseIf Not IsEmpty(adr(j, 5)) And adr(j + 1, 2) Like adr(j, 2) And adr(j + 1, 3) Like ("*" & adr(j, 3) & "*") And adr(j + 1, 4) Like adr(j, 4) Then '(B :si adresse j identique j+1)
adr(j + 1, 5) = adr(j, 5)
Exit For
ElseIf adr(j, 2) = rep(k, 1) And rep(k, 2) = "0-0-" And rep(k, 3) = "0-0-" Then '(C : si sans segmentation)
            If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
                If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then adr(j, 5) = rep(k, 6)
ElseIf adr(j, 2) = rep(k, 1) And Application.IsEven(adr(j, 4)) Then '(D : si voie paire)
            If (Split(rep(k, 2), "-")(0) = 0 And Split(rep(k, 2), "-")(1) > 0 And adr(j, 4) >= Split(rep(k, 2), "-")(1)) _
                Or (Split(rep(k, 2), "-")(0) > 0 And adr(j, 4) >= Split(rep(k, 2), "-")(0) And Split(rep(k, 2), "-")(1) > 0 And adr(j, 4) <= Split(rep(k, 2), "-")(1)) Then
                If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
                    If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then adr(j, 5) = rep(k, 6)
ElseIf adr(j, 2) = rep(k, 1) And Application.IsOdd(adr(j, 4)) Then '(E : si voie impaire)
            If (Split(rep(k, 3), "-")(0) = 0 And Split(rep(k, 3), "-")(1) > 0 And adr(j, 4) >= Split(rep(k, 3), "-")(1)) _
                Or (Split(rep(k, 3), "-")(0) > 0 And adr(j, 4) >= Split(rep(k, 3), "-")(0) And Split(rep(k, 3), "-")(1) > 0 And adr(j, 4) <= Split(rep(k, 3), "-")(1)) Then
                If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
                    If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then adr(j, 5) = rep(k, 6)
                        End If: End If: End If: End If: End If: End If
Range("H" & j) = adr(j, 5)
Next k: Next j
End Sub

La macro tourne mais les conditions B, D et E ne sont pas pris en compte. A cause de B la macro tourne très lentement et à cause de D et E les adresses dites segmentées (celles où le secteur est différent en fonction du numéro de voie) ne sont pas affectées au secteur correcte. J'ai vérifié les expressions "split", "isempty", "iseven" et "isodd" qui me retourne les valeurs souhaitées.

Quelqu'un voit ce qui cloche ?

[Bob78280]

Bonjour,

Je n'ai pas vérifié avec le fichier, mais ton imbrication de IF me semble fausse. Le IF de ta ligne 21 finit avec un END IF de la ligne 33. C'est pourquoi certains cas ne sont pas pris en compte.
Je t'envoie ma correction, un peu plus indentée pour une meilleure lecture

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
 
Sub recherchex()
Dim rep_d(), adr, rep, dico, i&, j&, nbl_r&, nbl_a&, temp, adr_b(), k%, rep_nbmot%, adr_nbmot%
 
nbl_a = Range("C2").End(xlDown).Row
nbl_r = Range("O3").End(xlDown).Row
 
ReDim adr(nbl_a), adr_b(nbl_a), rep(nbl_r), rep_b(nbl_r)
adr = Range("C2:G" & nbl_a).Value
rep = Range("O3:V" & nbl_r).Value
 
ReDim adr_b(nbl_a)
ReDim Preserve adr(LBound(adr) To UBound(adr), 1 To 5)
 
For j = LBound(adr) To UBound(adr)
    For k = LBound(rep) To UBound(rep)
    adr_b(j) = adr(j, 3)
    rep_nbmot = UBound(Split(rep(k, 4))) + 1
    adr_nbmot = UBound(Split(adr_b(j))) + 1
 
        If Not IsEmpty(Range("H" & j)) Or k = UBound(rep) Then '(A : si déjà rempli ou repertoire finit)
            Exit For
        ElseIf Not IsEmpty(adr(j, 5)) And adr(j + 1, 2) Like adr(j, 2) And adr(j + 1, 3) Like ("*" & adr(j, 3) & "*") And adr(j + 1, 4) Like adr(j, 4) Then '(B :si adresse j identique j+1)
            adr(j + 1, 5) = adr(j, 5)
            Exit For
        ElseIf adr(j, 2) = rep(k, 1) And rep(k, 2) = "0-0-" And rep(k, 3) = "0-0-" Then '(C : si sans segmentation)
            If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
                If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then adr(j, 5) = rep(k, 6)
            End If
        ElseIf adr(j, 2) = rep(k, 1) And Application.IsEven(adr(j, 4)) Then '(D : si voie paire)
            If (Split(rep(k, 2), "-")(0) = 0 And Split(rep(k, 2), "-")(1) > 0 And adr(j, 4) >= Split(rep(k, 2), "-")(1)) _
                Or (Split(rep(k, 2), "-")(0) > 0 And adr(j, 4) >= Split(rep(k, 2), "-")(0) And Split(rep(k, 2), "-")(1) > 0 And adr(j, 4) <= Split(rep(k, 2), "-")(1)) Then
                    If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
                        If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then adr(j, 5) = rep(k, 6)
                    End If
            End If
        ElseIf adr(j, 2) = rep(k, 1) And Application.IsOdd(adr(j, 4)) Then '(E : si voie impaire)
            If (Split(rep(k, 3), "-")(0) = 0 And Split(rep(k, 3), "-")(1) > 0 And adr(j, 4) >= Split(rep(k, 3), "-")(1)) _
                Or (Split(rep(k, 3), "-")(0) > 0 And adr(j, 4) >= Split(rep(k, 3), "-")(0) And Split(rep(k, 3), "-")(1) > 0 And adr(j, 4) <= Split(rep(k, 3), "-")(1)) Then
                    If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
                        If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then adr(j, 5) = rep(k, 6)
                    End If
            End If
        End If
    Range("H" & j) = adr(j, 5)
    Next k
Next j
End Sub

[unparia]

Bonjour
cela va plus loin.
Voilà ce que l'on voit lorsque l'on prend le soin d'indenter proprement :

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
If Not IsEmpty(Range("H" & j)) Or k = UBound(rep) Then
 Exit For
ElseIf Not IsEmpty(adr(j, 5)) And adr(j + 1, 2) Like adr(j, 2) And adr(j + 1, 3) Like ("*" & adr(j, 3) & "*") And adr(j + 1, 4) Like adr(j, 4) Then
  adr(j + 1, 5) = adr(j, 5)
  Exit For
ElseIf adr(j, 2) = rep(k, 1) And rep(k, 2) = "0-0-" And rep(k, 3) = "0-0-" Then
  If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
    If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then adr(j, 5) = rep(k, 6)
  ElseIf adr(j, 2) = rep(k, 1) And Application.IsEven(adr(j, 4)) Then
    If (Split(rep(k, 2), "-")(0) = 0 And Split(rep(k, 2), "-")(1) > 0 And adr(j, 4) >= Split(rep(k, 2), "-")(1)) _
    Or (Split(rep(k, 2), "-")(0) > 0 And adr(j, 4) >= Split(rep(k, 2), "-")(0) And Split(rep(k, 2), "-")(1) > 0 And adr(j, 4) <= Split(rep(k, 2), "-")(1)) Then
      If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
        If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then adr(j, 5) = rep(k, 6)
      ElseIf adr(j, 2) = rep(k, 1) And Application.IsOdd(adr(j, 4)) Then
        If (Split(rep(k, 3), "-")(0) = 0 And Split(rep(k, 3), "-")(1) > 0 And adr(j, 4) >= Split(rep(k, 3), "-")(1)) _
        Or (Split(rep(k, 3), "-")(0) > 0 And adr(j, 4) >= Split(rep(k, 3), "-")(0) And Split(rep(k, 3), "-")(1) > 0 And adr(j, 4) <= Split(rep(k, 3), "-")(1)) Then
          If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
            If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then adr(j, 5) = rep(k, 6)
          End If
        End If
      End If
  End If
End If
End If

Il y a là comme un malaise ....

[SectoSSD]

Merci pour vos réponses,

j'ai pas mal bossé sur le traitement de chaine de caractères mais c'est la première fois que je fais une structure conditionnelle un peu élaboré.

Sur internet c'est difficile de trouver des tutos pour des cas qui vont au delà du if... then un peu basique.

En effet malgré les améliorations de Bob78280 les condition B, D et E ne fonctionne toujours pas...

[SectoSSD]

@unparia

Est-ce à dire qu'il faut que je revoit l'organisation des if en dépit des modif ci-dessus ?

En tout cas, en effet, ça ne marche pas ...

[Bob78280]

Bonjour,

Tiens, le code ci dessous devrait marcher.
Comme erreurs, il y avait :
- ta variable adr doit aussi commencer en C3
- j correspond au positionnement de lecture dans adr, or adr(j,1) correspond à range("A" & j+2) et pas à range("A" & j+1)
- B : une comparaison j / j+1 au lieu de j / j-1
- D & E : le split te renvoie une valeur en format texte, que tu compares avec un nombre
- la mise à jour de la colonne H dans la boucle k, or quand tu fais un exit for, tu ne mets pas à jour ta colonne ...

- j'ai ajouté une sortie automatique dès que tu trouves l'adresse, ce qui évite de lire toutes les adresses suivantes => gain de temps

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
 
Sub recherchex()
Dim rep_d(), adr, rep, dico, i&, j&, nbl_r&, nbl_a&, temp, adr_b(), k%, rep_nbmot%, adr_nbmot%
 
nbl_a = Range("C3").End(xlDown).Row
nbl_r = Range("O3").End(xlDown).Row
 
ReDim adr(nbl_a), adr_b(nbl_a), rep(nbl_r), rep_b(nbl_r)
adr = Range("C3:H" & nbl_a).Value
rep = Range("O3:V" & nbl_r).Value
 
ReDim adr_b(nbl_a)
ReDim Preserve adr(LBound(adr) To UBound(adr), 1 To 5)
 
For j = LBound(adr) To UBound(adr) 
    For k = LBound(rep) To UBound(rep)
    adr_b(j) = adr(j, 3)
    rep_nbmot = UBound(Split(rep(k, 4))) + 1
    adr_nbmot = UBound(Split(adr_b(j))) + 1
 
        If Not IsEmpty(Range("H" & j + 2)) Then 'Or k = UBound(rep) Then '(A : si déjà rempli ou repertoire finit)
            adr(j, 5) = Range("H" & j + 2)
            Exit For
        ElseIf (Not IsEmpty(adr(j - 1, 5))) And adr(j - 1, 2) Like adr(j, 2) And adr(j - 1, 3) Like ("*" & adr(j, 3) & "*") And adr(j - 1, 4) Like adr(j, 4) Then '(B :si adresse j identique j-1)
            adr(j, 5) = adr(j - 1, 5)
            Exit For
        ElseIf adr(j, 2) = rep(k, 1) And rep(k, 2) = "0-0-" And rep(k, 3) = "0-0-" Then '(C : si sans segmentation)
            If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
                If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then
                    adr(j, 5) = rep(k, 6)
                    Exit For
                End If
            End If
        ElseIf adr(j, 2) = rep(k, 1) And Application.IsEven(adr(j, 4)) Then '(D : si voie paire)
            If (CLng(Split(rep(k, 2), "-")(0)) = 0 And CLng(Split(rep(k, 2), "-")(1)) > 0 And adr(j, 4) >= CLng(Split(rep(k, 2), "-")(1))) _
                Or (CLng(Split(rep(k, 2), "-")(0)) > 0 And adr(j, 4) >= CLng(Split(rep(k, 2), "-")(0)) And CLng(Split(rep(k, 2), "-")(1)) > 0 And adr(j, 4) <= CLng(Split(rep(k, 2), "-")(1))) Then
                    If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
                        If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then
                            adr(j, 5) = rep(k, 6)
                            Exit For
                        End If
                    End If
            End If
        ElseIf adr(j, 2) = rep(k, 1) And Application.IsOdd(adr(j, 4)) Then '(E : si voie impaire)
            If (CLng(Split(rep(k, 3), "-")(0)) = 0 And CLng(Split(rep(k, 3), "-")(1)) > 0 And adr(j, 4) >= CLng(Split(rep(k, 3), "-")(1))) _
                Or (CLng(Split(rep(k, 3), "-")(0)) > 0 And adr(j, 4) >= CLng(Split(rep(k, 3), "-")(0)) And CLng(Split(rep(k, 3), "-")(1)) > 0 And adr(j, 4) <= CLng(Split(rep(k, 3), "-")(1))) Then
                    If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
                        If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then
                            adr(j, 5) = rep(k, 6)
                            Exit For
                        End If
                    End If
            End If
        End If
 
    Next k
    Range("H" & j + 2) = adr(j, 5)
Next j
End Sub

[SectoSSD]

Waho ! Merci !

Pour la variable en C3 il se trouve en faite que j'ai un peu réarranger ma base pour la photo et que la mienne commence en C2

La Macro marche et, en plus beaucoup plus vite.

Une seule chose : elle marche seulement quand je "débranche" le premier elsif qui met un message d'erreur à cause de la première ligne qui, avec j-1 donne 0 soit une ligne qui n'existe pas dans la table. J'avais déjà essayé cette option et la solution suivante bloque la boucle j au niveau 0 (pourquoi ?) :

Code :

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

1
2
3
4
5
6
 
        ElseIf j > 1 Then
            If (Not IsEmpty(adr(j - 1, 5))) And adr(j - 1, 2) Like adr(j, 2) And adr(j - 1, 3) Like ("*" & adr(j, 3) & "*") And adr(j - 1, 4) Like adr(j, 4) Then '(B :si adresse j identique j-1)
                adr(j, 5) = adr(j - 1, 5)
                Exit For
            End If

Merci encore !