Erreur incompréhensible dans ma Macro (VBA) à l'aide!

**Wendy_26** · 02/09/2014, 15h01

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é · 02/09/2014, 15h18

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** · 02/09/2014, 15h37

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é · 02/09/2014, 16h40

Code pas testé :

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

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

**piotr76** · 02/09/2014, 18h57

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** · 02/09/2014, 19h56

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

**Igloobel** · 02/09/2014, 21h25

Bonsoir,

J'ai pas regarder à fond mais il me semble bien que lorsque l'on construit une plage les séparateurs sont les ":" et ";" et non pas ","

vu que notre amie nous dit

...et la sélection fonctionne quand une seule ligne correspond mais quand il y en a plusieurs cela bloque...

A+

**parmi** · 02/09/2014, 21h48

Le problème vient du fait qu'elle utilise Rows plutôt que Range.
Et comme c'est en VBA, les séparateurs ":" et "," sont corrects... anglais oblige...

Invité · 03/09/2014, 00h01

Non c'est obligé mais si tu veux!

Envoyé par 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

**Wendy_26** · 03/09/2014, 07h25

Envoyé par rdurupt

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!

Envoyé par bbil

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** · 03/09/2014, 08h14

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

**parmi** · 03/09/2014, 11h43

Lorsque tu déclares des variables concernant le nombre de lignes ou servant à boucler le nombre de lignes, utilise le Long plutôt que Integer.
Un Integer va te donner une erreur un jour ou l'autre...

Et, de toutes façons, avec les machines que nous avons maintenant, ce n'est plus vraiment important de réduire au minimum l'espace mémoire alloué par les variables...

Bonne continuation à toi aussi.

Invité · 03/09/2014, 12h50

Envoyé par Wendy_26

Hello messieurs!

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
        '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

simplifies ton code le reste n'est pas utile!

Code :

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

1
2
 If Contrôle_Dossier = True And Contrôle_Langue = True Then
    Sheets("RCEL").Range( i & ":" & i ).copy Sheets("Selection").Range("A" & k)

Envoyé par Wendy_26

Hello messieurs!

Code :

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

1
2
3
4
Sheets("Selection").Select
    Rows("20:20").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents

Code :

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

1
2
3
 
Set r =Sheets("Selection").Rows("20:20")
 Range(r, r.End(xlDown)).ClearContents

**Wendy_26** · 04/09/2014, 08h09

Merci pour ces petites améliorations!
J'ai aussi changer les déclarations de variables en Long!

**Wendy_26** · 04/09/2014, 11h06

Hello les copains!

Je reviens à la charge avec une autre problématique!
Dans le même fichier, au début j'importe des données issues d'un autre classeur. Or dans ces données il y a des listes déroulantes de choix (Monsieur, Madame, Autre) par exemple. Est-il possible de coller les cellules en enlevant ces listes de choix? J'ai le code suivant :

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
 
Sub copy()
' Variable pour le classeur où sera copié la base de donnée
Set NwWBK = ThisWorkbook
' Ouverture par l'utilisateur du classeur à copier
Dim Fichier As Variant
Fichier = Application.GetOpenFilename(Title:="Choix du fichier de comparaison")
If Fichier <> False Then
Set Fich = Workbooks.Open(Fichier)
End If
Set OldWBK = ActiveWorkbook
 
'Copie de la feuille RCEL
If NwWBK.Worksheets("RCEL").AutoFilterMode Then
     NwWBK.Worksheets("RCEL").AutoFilterMode = False
End If
 
OldWBK.Worksheets("RCEL").Cells.copy _
NwWBK.Worksheets("RCEL").Range("A1")  '.PasteSpecial Paste:=xlPasteValues ' Copie-colle le fichier
OldWBK.Close False 'Referme le fichier source
'NwWBK.Worksheets("RCEL").Range("A1:FS1000").Value = NwWBK.Worksheets("RCEL").Range("A1:FS1000").Value
' Figer la ligne supérieur de la feuille RCEL
    With Worksheets("RCEL").Activate
        ActiveWindow.SplitColumn = 0
        ActiveWindow.SplitRow = 1
    End With
     ActiveWindow.FreezePanes = True
 
End Sub

J'ai essayé de copier en tant que valeur avec pastespecial mais il y a une erreur insoluble apparemment liée à ces listes...
La copie avec "=" afin de faire une copie en tant que valeur n'enlèvent pas les listes non plus.

Invité · 04/09/2014, 11h35

Envoyé par Wendy_26

Hello les copains!

J'ai essayé de copier en tant que valeur avec pastespecial mais il y a une erreur insoluble apparemment liée à ces listes...
La copie avec "=" afin de faire une copie en tant que valeur n'enlèvent pas les listes non plus.

bonjour,
test ce code

Code :

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

1
2
Set r = OldWBK.Worksheets("RCEL").UsedRange
NwWBK.Worksheets("RCEL").Range(r.Address).Value = r.Cells.Value

**Wendy_26** · 04/09/2014, 11h40

Hello,

Merci c'est parfait comme ça!

Erreur incompréhensible dans ma Macro (VBA) à l'aide! [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager