Boucles et tableaux

**Frizz** · 15/08/2013, 01h19

Bonjour a tous,

Je suis actuellement sur un projet de stage et je bloque un peu...
J'ai mis mon fichier excel en PJ et le code que j'ai ecrit pour l'instant ci dessous. Il doit y a voir une erreur dans une des declarations mais je ne trouve vraiment pas...
Voila quelques explication supplementaires pour vous aider a comprendre mon projet. Pour chaque cellule du 2eme grand tableau bleu differente de "-" je teste d'abord le Q11 correspondant en le comparant aux valeurs reference de Q11 (dernier tableau orange) et je cree un tableau (virtuel seulement) qui recupere la liste de tous les profils compatibles. Je fais ensuite de meme avec n11 (la valeur inscite dans la cellule) et cree un autre tableau virtuel qui regroupe les profils possibles. L'idee est ensuite de comparer ces deux tableau et si un profil appartient au deux alors je veux inscrire sur ma feuille le profil, le D et le n qui correspondent.

J'espere avoir ete assez claire, merci de 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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Explicit
 
Sub essai()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
Dim lig As Long
Dim col As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim n As Long
Dim nombre As Long
 
For lig = 37 To 63
    For col = 11 To 27
        If Cells(lig, col).Value <> "-" Then
        Dim tabl(500) As String
        Dim table(500) As String
 
            For k = 58 To 77
                Dim nbr
                If Cells(lig, 9).Value > Cells(k, 2) And Cells(lig, 9).Value < Cells(k, 4) Then
                    nbr = nbr + 1
                    tabl(nbr) = Cells(k, 1).Value
                End If
            Next k
 
            For l = 36 To 55
                Dim nbre
                If Cells(lig, col).Value > Cells(l, 2) And Cells(lig, col).Value < Cells(l, 4) Then
                    nbre = nbre + 1
                    table(nbre) = Cells(l, 1).Value
                End If
            Next l
 
            For m = 1 To 500
                For n = 1 To 500
                    If tabl(m) = table(n) Then
                        nombre = nombre + 1
                        Cells(nombre, 5).Value = tabl(m)
                        Cells(nombre, 6).Value = Cells(lig, 10).Value
                        Cells(nombre, 7).Value = Cells(3, col).Value
                    End If
                Next n
            Next m
 
        End If
    Next col
Next lig
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

**Daniel.C** · 15/08/2013, 13h09

Bonjour,

Pourquoi dis-tu qu'il y a une erreur ?

**parmi** · 15/08/2013, 16h03

Une bonne habitude, selon moi, est de déclarer les variables en entête de procédure seulement...
Et comme déjà dit, où et quelle est l'erreur ?

**Frizz** · 15/08/2013, 18h10

Lorsque je lance la macro, apres un temps (bien trop long soit disant passant), une erreur apparait. Aleatoirement j'ai soit une erreur 404 soit une erreur "Application-defined or object-defined error"
D'habitude l'endroit qui bloque est surligne dans le code mais la rien n'est mis en evidence donc je ne trouve pas l'erreur...

**Daniel.C** · 15/08/2013, 18h32

C'est cette boucle-ci qui fait que c'est long (250000 cycles à chaque passage) :

Code :

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

1
2
3
4
5
6
7
8
9
10
            For m = 1 To 500
                For n = 1 To 500
                    If tabl(m) = table(n) Then
                        nombre = nombre + 1
                        Cells(nombre, 5).Value = tabl(m)
                        Cells(nombre, 6).Value = Cells(lig, 10).Value
                        Cells(nombre, 7).Value = Cells(3, col).Value
                    End If
                Next n
            Next m

Tu devrais pouvoir la remplacer par :

Code :

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

1
2
3
4
5
6
7
8
9
10
            For m = 1 To 500
                If tabl(m) <> "" Then
                    If IsNumeric(Application.Match(tabl(m), table, 0)) Then
                        nombre = nombre + 1
                        Cells(nombre, 5).Value = tabl(m)
                        Cells(nombre, 6).Value = Cells(lig, 10).Value
                        Cells(nombre, 7).Value = Cells(3, col).Value
                    End If
                End If
            Next m

et peut-être même sortir de la boucle si l'item de la table est vide.

**Frizz** · 15/08/2013, 19h13

Deja merci beaucoup pour cette reactivite!
La solution proposee accelere enormement l'execution de la macro et il n'y a plus d'erreur!
Neanmoins, aucune solution n'est retrounee! Rien ne s'ecrit sur ma feuille... Alors que je sais les solutions attendues...

**parmi** · 15/08/2013, 19h26

Est-ce que ceci te retournerait ce que tu attends ?

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
Sub essai()
    Dim lig As Long
    Dim col As Long
    Dim k As Long
    Dim l As Long
    Dim m As Long
    Dim n As Long
    Dim nombre As Long
    Dim tabl() As String
    Dim table() As String
    Dim nbr
    Dim nbre
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    For lig = 37 To 63
        For col = 11 To 27
            If Cells(lig, col).Value <> "-" Then
 
                ReDim tabl(0)
                ReDim table(0)
 
                nbr = 0
                For k = 58 To 77
                    If Cells(lig, 9).Value > Cells(k, 2) And Cells(lig, 9).Value < Cells(k, 4) Then
                        nbr = nbr + 1
                        ReDim Preserve tabl(nbr)
                        tabl(nbr) = Cells(k, 1).Value
                    End If
                Next k
 
                nbre = 0
                For l = 36 To 55
                    If Cells(lig, col).Value > Cells(l, 2) And Cells(lig, col).Value < Cells(l, 4) Then
                        nbre = nbre + 1
                        ReDim Preserve table(nbre)
                        table(nbre) = Cells(l, 1).Value
                    End If
                Next l
 
                For m = 1 To UBound(tabl)
                    For n = 1 To UBound(table)
                        If tabl(m) = table(n) Then
                            nombre = nombre + 1
                            Cells(nombre, 5).Value = tabl(m)
                            Cells(nombre, 6).Value = Cells(lig, 10).Value
                            Cells(nombre, 7).Value = Cells(3, col).Value
                        End If
                    Next n
                Next m
 
            End If
        Next col
    Next lig
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
    MsgBox "Terminé"
End Sub

**Frizz** · 15/08/2013, 19h45

Malheureusement je n'ai toujorus rien qui s'affiche a la fin de la procedure alros que je sais qu'il y a des solutions...
Je ne vois cependant pas ou est le pb!

**parmi** · 15/08/2013, 19h55

Je vois pourtant des données s'afficher dans les cellules E1 à G5.
Mais ce n'est peut-être pas ce que tu veux afficher... (?)

**Frizz** · 15/08/2013, 20h01

Rien ne s'affiche de mon cote! c'est extremement frustrant...

**Frizz** · 15/08/2013, 20h07

Au temps pour moi, je n'avais pas place le code au bon endroit!
La liste affichee me semble correcte!

Mille merci pour votre aide inestimable!

**Philippe Tulliez** · 15/08/2013, 20h09

Bonjour,
Lorsque tu lances ta procédure, est-ce bien la feuille où se trouve tes données qui est active parce-que comme tu utilises l'objet Cells sans préciser les objets parents (workbook et worksheet) il est possible que tu lises des cellules vides.

Boucles et tableaux [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager