Discussion :

[Wendy_26]

Bonjour à tous,

Dans le cadre de mon stage, je dois "pimper" un fichier excel avec tout un tas de macro. Là j'en ai fait une pour sélectionner des lignes qui correspondent à un ou deux critères. Le problème que je ne comprends pas se situe à la ligne ou je sélectionne les données. Le programme bloque dessus et me met une erreur de variable incompatible!

J'ai fait une macro plus simple qui fait presque la même chose (mais tous les critères doivent être renseignés) et la sélection fonctionne quand une seule ligne correspond mais quand il y en a plusieurs cela bloque...

J'ai besoin donc de l'aide d'un gentils exceliste pour me sortir de ce pétrin!

Merci d'avance

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
79
80
81
 
Sub Recherche_Critères()
Dim i As Integer, j As Byte, DerLig As Integer
Dim Contrôle_Dossier As Boolean, Contrôle_Langue As Boolean, Contrôle_Société As Boolean
Dim Drapeau As Boolean
Dim MesLignes
 
    DerLig = Sheets("RCEL").Range("A" & Rows.Count).End(xlUp).Row
 
 
    For i = 20 To DerLig ' Lignes de la feuille 'RCEL'
 
        'Dossier N° ------------ Début
        If Sheets("Filtre").Range("A25") = "" Then
            Contrôle_Dossier = True
            GoTo Etiquette_Langue
        End If
 
       'Colonnes A
            If Sheets("Filtre").Range("A25") = Sheets("RCEL").Cells(i, 1) Then
                Contrôle_Dossier = True
                GoTo Etiquette_Langue
            End If
 
        'LOCALITES ------------ Fin
 
 
 
        'Langue ------------ Début
Etiquette_Langue:
 
        If Sheets("Filtre").Range("B25") = "" Then
            Contrôle_Langue = True
        End If
 
        'Colonnes B
            If Sheets("Filtre").Range("B25") = Sheets("RCEL").Cells(i, 2) Then
                Contrôle_Langue = True
            End If
 
        'Langue ------------ Fin
 
        'FACADE ------------ Début
'Etiquette_FACADE:
        'If .Cells(i, 7) >= Range("R" & ActiveCell.Row) Then Contrôle_Façade = True
        'FACADE ------------ Fin
 
 
 
        'DIMENSION ------------ Début
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Etiquette_DIMENSION:
        'DIMENSION ------------ Fin
 
        'Résultat
        If Contrôle_Dossier = True And Contrôle_Langue = True Then
            'MsgBox ("Le dossier " & Sheets("RCEL").Cells(i, 1) & " conviendrait à ce(s) critères")
            MesLignes = MesLignes & i & ":" & i & "," 'Stockage des lignes qui répondent au critère
            Drapeau = True
        End If
 
 
 
 
        Contrôle_Dossier = False
        Contrôle_Langue = False
        'Contrôle_Façade = False
 
    Next i
 
 
 
If Drapeau = False Then MsgBox "Aucun dossier correspondant aux critères (vérifier les critères)"
If MesLignes <> "" Then
Worksheets("RCEL").Activate
MesLignes = Left(MesLignes, Len(MesLignes) - 1)
MsgBox ("Mes lignes " & MesLignes)
MesLignes = CStr(MesLignes)
Sheets("RCEL").Rows(MesLignes).Select
End If
 
End Sub

Ci-dessus c'est la macro qui ne fonctionne pas...du moins dès qu'il y a plusieurs entités qui correspondent aux critères. Je pense donc que l'écriture de la variable MesLignes comporte une erreur!
Cependant quand je l'affiche dans la messagebox, elle semble correcte:

12:12,15:15,67:67

Voilà merci de votre aide je suis toute désespérée

[Invité]

Code :

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

1
2
3
4
5
6
7
8
9
If Contrôle_Dossier = True And Contrôle_Langue = True Then
            'MsgBox ("Le dossier " & Sheets("RCEL").Cells(i, 1) & " conviendrait à ce(s) critères")
            If Trim("" & MesLignes) = "" Then
                MesLignes = i & ":" & i    'Stockage des lignes qui répondent au critère
            Else
            MesLignes = MesLignes & "," & i & ":" & i  'Stockage des lignes qui répondent au critère
            End If
            Drapeau = True
        End If

Code :

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

1
2
3
4
5
6
7
If Trim("" & MesLignes) <> "" Then
    Worksheets("RCEL").Activate
    'MesLignes = Left(MesLignes, Len(MesLignes) - 1)
    MsgBox ("Mes lignes " & MesLignes)
    'MesLignes = CStr(MesLignes)
    Sheets("RCEL").Range(MesLignes).Select
End If

[Wendy_26]

Bonjour rdurupt!

Merci de ta contribution! Alors cela fonctionne si j'ai un nombre limite de données mais si je le fais sur toutes mes données il y aurait apparemment trop de lignes à sélectionner!

Il y a un nombre limite de lignes pour la sélection multi-ligne? L'erreur vient apparemment de là!

Du coup il faudrait qu'à chaque fois que le code trouve une correspondance, qu'il copie cette ligne sur une nouvelle feuille puis ajoute les autres correspondances en-dessous! C'est possible ça?

[Invité]

Code pas testé :

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

Sheets("RCEL").Rows(MesLignes).copy  Sheets("FEUILLE").range("A1")

[piotr76]

Bonjour
Vite fait en passant. Il ne manquerait pas un "Destination" pour le "copy"

Code :

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

Sheets("RCEL").Rows(MesLignes).copy  Destination:=Sheets("FEUILLE").range("A1")

Cordialement

[SfJ5Rpw8]

bonsoir,

cela n'as peu être rien à voir mais pourquoi déclarer votre variable en variant

Code :

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

Dim MesLignes

alors que le type désiré est connu : chaine :

Code :

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

Dim MesLignes as  string

[Invité]

Non c'est obligé mais si tu veux!

Bonjour
Vite fait en passant. Il ne manquerait pas un "Destination" pour le "copy"

Code :

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

Sheets("RCEL").Rows(MesLignes).copy  Destination:=Sheets("FEUILLE").range("A1")

Cordialement

[Wendy_26]

Code pas testé :

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

Sheets("RCEL").Rows(MesLignes).copy  Sheets("FEUILLE").range("A1")

Merci rdurupt! Ce code marche du tonnerre à nouveau! Toutefois quand il y a beaucoup de lignes, cela ne marche plus. Pour une ou trois il y a aucun soucis! Du coup je vais devoir intégrer cela directement dans la boucle et faire la copie au fur et à mesure qu'il trouve des correspondances!

bonsoir,

cela n'as peu être rien à voir mais pourquoi déclarer votre variable en variant

Code :

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

Dim MesLignes

alors que le type désiré est connu : chaine :

Code :

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

Dim MesLignes as  string

Hello bbil! Tout simplement car je n'étais pas sûre que c'était du string. Mais les deux fonctionnent en tout cas

Merci à Igloobel, Piotr76 et parmi d'avoir donné une réponse ou une explication!

Je vais de ce pas m'attaquer à la copie dynamique et je reviens vous voir pour donner le résultat qui marche je l'espère

bye bye

[Wendy_26]

Hello messieurs!

Alors voilà le code final qui fonctionne parfaitement!

J'ai conservé la variable MesLignes en guise de contrôle comme j'ai 120 autres critères à ajouter, il va falloir faire des tests pour tout vérifier. J'ai donc créer un incrément k et une variable CopyLigne qui copie et colle la ligne à copier dans la feuille "Selection"! J'ai aussi rajouter 3 lignes en début de code qui vident les enregistrements copiés dans "Selection" lors de la recherche précédente!

En tout cas un gros merci à tous et bonne continuation

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Sub Recherche_Critères()
Dim i As Integer, j As Byte, DerLig As Integer
Dim Contrôle_Dossier As Boolean, Contrôle_Langue As Boolean, Contrôle_Société As Boolean
Dim Drapeau As Boolean
Dim MesLignes As String
Dim k As Integer 'compteur des lignes à copier
Dim LignesCopy As String 'numéro de la ligne à copier
 
' SUPPRESSION DES DONNES SELECTIONNEES LORS D'UNE UTILISATION PRECEDENTES
    Sheets("Selection").Select
    Rows("20:20").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
' -----------------------------------------------------------------------
 
    DerLig = Sheets("RCEL").Range("A" & Rows.Count).End(xlUp).Row
 
    k = 20 'initialisation du compteur au numéro de la première ligne (i.e. 20)
    For i = 20 To DerLig ' Lignes de la feuille 'RCEL'
 
        'Dossier N° ------------ Début
        If Sheets("Filtre").Range("A25") = "" Then
            Contrôle_Dossier = True
            GoTo Etiquette_Langue
        End If
 
       'Colonnes A
            If Sheets("Filtre").Range("A25") = Sheets("RCEL").Cells(i, 1) Then
                Contrôle_Dossier = True
                GoTo Etiquette_Langue
            End If
 
        'LOCALITES ------------ Fin
 
 
 
        'Langue ------------ Début
Etiquette_Langue:
 
        If Sheets("Filtre").Range("B25") = "" Then
            Contrôle_Langue = True
        End If
 
        'Colonnes B
            If Sheets("Filtre").Range("B25") = Sheets("RCEL").Cells(i, 2) Then
                Contrôle_Langue = True
            End If
 
        'Langue ------------ Fin
 
        'FACADE ------------ Début
'Etiquette_FACADE:
        'If .Cells(i, 7) >= Range("R" & ActiveCell.Row) Then Contrôle_Façade = True
        'FACADE ------------ Fin
 
 
 
        'DIMENSION ------------ Début
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Etiquette_DIMENSION:
        'DIMENSION ------------ Fin
 
        'Résultat
       If Contrôle_Dossier = True And Contrôle_Langue = True Then
 
            If Trim("" & MesLignes) = "" Then
                MesLignes = i & ":" & i    'Stockage des lignes qui répondent au critère
            Else
            MesLignes = MesLignes & "," & i & ":" & i  'Stockage des lignes qui répondent au critère
            End If
            LignesCopy = i & ":" & i
            Sheets("RCEL").Range(LignesCopy).copy Sheets("Selection").Range("A" & k)
            k = k + 1
            Drapeau = True
        End If
 
 
 
        Contrôle_Dossier = False
        Contrôle_Langue = False
        'Contrôle_Façade = False
 
    Next i
 
 
 
If Drapeau = False Then MsgBox "Aucun dossier correspondant aux critères (vérifier les critères)"
 
If Trim("" & MesLignes) <> "" Then
    Worksheets("Selection").Activate
    MsgBox ("Mes lignes " & MesLignes)
End If
 
End Sub