For"if and if"next - Mes ifs indiquent une incompatibilité de type?

**pruneenurp** · 09/09/2014, 19h44

Cher tous,

Je bug à nouveau.
Je fais une recherche mutiple sur un fichier. Chaque recherche devant répondre à deux conditions. La seconde condition definit si la ligne est copiée sur la feuille un ou copiée sur la ligne deux. et ainsi de suite.

J'ai tenté un autofilter mais je retrouve avec une impossibilité de copier a cause de taille differente pourtant aucune cellule fusionne pas de couleur rien dans mon fichier.
Pas grave je passe à la seconde méthode qui me parait plus jouable pour eviter les erreurs liés au filtre donc le If and If que me parait assez simple et pourtant non ca ne passe pas incompatibilité de type.

A nouveau heeeeeeellllppppppppppp!!!!!! (il n'y a pas le smiley "pleure" mais je pleure)

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
Dim wb As Workbook
Dim ws As Worksheet
Dim wsdata As Worksheet, wsrecherche As Worksheet, wsconsultation As Worksheet
Dim Cel As Range, cle_un As Range, cle_deux As Range, cle_trois As Range, col1 As Range, col2 As Range
Dim resultat As Variant
 
 
'initialiser les variables
Set wb = ThisWorkbook
Set wsdata = wb.Sheets("E30")
Set wsrecherche = wb.Sheets("base")
Set wsconsultation = wb.Sheets("consult")
Set cle_un = wsrecherche.Range("F3")
Set cle_deux = wsrecherche.Range("F4")
Set cle_trois = wsrecherche.Range("F5")
Set col1 = wsdata.Range("A1:A20000")
Set col2 = wsdata.Range("Q1:Q20000")
 
wsconsultation.Range("A14:BZ60000").ClearContents
 
'rechercher---------------------------------------------------------
 
 
 
For Each Cel In wsdata.Rows
If col1.Value = cle_un.Value And col2.Value = cle_deux.Value Then
 
resultat = resultat + 1
col1.Offset(0, 2).Copy Destination:=wsconsultation.Range("b14").Offset(resultat)
col1.Offset(0, 9).Copy Destination:=wsconsultation.Range("c14").Offset(resultat)
col1.Offset(0, 6).Copy Destination:=wsconsultation.Range("d14").Offset(resultat)
col1.Offset(0, 10).Copy Destination:=wsconsultation.Range("e14").Offset(resultat)
col1.Offset(0, 15).Copy Destination:=wsconsultation.Range("f14").Offset(resultat)
col1.Offset(0, 16).Copy Destination:=wsconsultation.Range("G14").Offset(resultat)
 
Else
 
If col1.Value = cle_un.Value And col2.Value = cle_trois.Value Then
 
resultat = resultat + 1
col1.Offset(0, 2).Copy Destination:=ws.Range("b14").Offset(resultat)
col1.Offset(0, 9).Copy Destination:=ws.Range("c14").Offset(resultat)
col1.Offset(0, 6).Copy Destination:=ws.Range("d14").Offset(resultat)
col1.Offset(0, 10).Copy Destination:=ws.Range("e14").Offset(resultat)
col1.Offset(0, 15).Copy Destination:=ws.Range("f14").Offset(resultat)
col1.Offset(0, 16).Copy Destination:=ws.Range("G14").Offset(resultat)
End If
End If
Next
End Sub

Quelqu'un peut il me venir en aide??? je sais que VBA exige de la finesse mais alors là...je vois pas ou plus.

Merci infiniment par avance!!!

**Marc-L** · 09/09/2014, 22h42

Bonjour, bonsoir !

Le message d'erreur c'est bien mais indiquer aussi le numéro de la ligne déclenchant cette erreur c'est mieux !

Cette erreur survient lorsque torchons et serviettes sont mélangées ! Le type de données n'est pas celui attendu …

Voilà, voilà !

Edit : la ligne n°26 peut-être ? Comparer cellule par cellule, pas possible sur une plage. Et filtrer est pourtant plus rapide …

**pruneenurp** · 09/09/2014, 22h54

Salut salut
Merci pour cette réponse. Bon visiblement je suis une spécialiste du mélange des genres mais je ne sais pas encore distinguer.

Et oui exactement sur la ligne 26..

Probleme de l'autofiltre est qui'l m'indique une impossiblité de copier en raison de taille de cellule differente...Et là pareil je comprends.
Suis passée a l'option deux car cela me permettait d'apprendre... au passage..

**Theze** · 13/09/2014, 15h34

Bonjour,

Quand je vois ce code, je me dis que tu est bien loin d'avoir résolu le problème !
Je pense qu'il serait mieux que tu nous explique le plus précisément possible ce que tu souhaite faire.

Hervé.

**pruneenurp** · 13/09/2014, 20h03

Oui c'est assez vilain. Mais meme en essayant de faire qlq chose d'a peu près propre et simple avec find next je ne sais remonter que la premiere ligne.
J'apprends par conséquent je ne distingue pas encore les torchons et les serviettes mais progressivement.... j'espère.

Bref ici j'essaie de faire ceci :
Si dans la colonne A de la feuille 1 je retrouve le mot correspondant à un nom "laurent" et si dans la colonne Q de la meme ligne je retrouve le mot "triste".
Alors les colonnes B, E, G, H et M de la ligne trouvée doivent être collée dans la feuille 2,a partir de la cellule B8
Si dans la colonne Q je retrouve le mot "heureux", alors les colonnes B, E,G,H et M doivent être collées dans la feuille 3 a partir de la ligne 8,col B.
Et ainsi de suite sur mes 70000 lignes jusque trouver le dernier mot correspondant à laurent de la colonne A.

**Theze** · 14/09/2014, 09h32

Bonjour,

Teste ceci sur une copie de ton classeur et adapte (vérifie la correspondance des noms de feuilles) :

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
94
95
96
97
98
99
100
 
'Si dans la colonne A de la feuille 1 je retrouve le mot correspondant à un nom "laurent" et si dans la colonne Q de la meme ligne je retrouve le mot "triste".
'Alors les colonnes B, E, G, H et M de la ligne trouvée doivent être collée dans la feuille 2,a partir de la cellule B8
'Si dans la colonne Q je retrouve le mot "heureux", alors les colonnes B, E,G,H et M doivent être collées dans la feuille 3 a partir de la ligne 8,col B.
'Et ainsi de suite sur mes 70000 lignes jusque trouver le dernier mot correspondant à laurent de la colonne A.
 
Sub Test()
 
    Dim ws As Worksheet
    Dim WsData As Worksheet
    Dim WsRecherche As Worksheet
    Dim WsConsultation As Worksheet
    Dim Cel As Range
    Dim cle_un As Range
    Dim cle_deux As Range
    Dim cle_trois As Range
    Dim Plage As Range
    Dim Adr As String
    Dim DerLgnWsConsul As Long
    Dim DerLgnWsRech As Long
 
 
 
    'initialiser les variables
    Set WsData = Sheets("E30")
    Set WsRecherche = Sheets("base")
    Set WsConsultation = Sheets("consult")
 
    Set cle_un = WsRecherche.Range("F3")
    Set cle_deux = WsRecherche.Range("F4")
    Set cle_trois = WsRecherche.Range("F5")
 
 
    WsConsultation.Range("A14:BZ60000").ClearContents
 
    With WsData
 
        Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    With WsConsultation
 
        DerLgnWsConsul = .Cells(.Rows.Count, 2).End(xlUp).Row + 1 'sur colonne B
 
        'a partir de la cellule B8
        If DerLgnWsConsul < 9 Then DerLgnWsConsul = 9
 
    End With
 
    With WsRecherche
 
        DerLgnWsRech = .Cells(.Rows.Count, 2).End(xlUp).Row + 1 'sur colonne B
 
        'a partir de la cellule B8
        If DerLgnWsRech < 9 Then DerLgnWsRech = 9
 
    End With
 
    'Si dans la colonne A de la feuille 1 je retrouve le mot correspondant à un nom "laurent"
    Set Cel = Plage.Find(cle_un.Value, , xlValues, xlWhole)
 
    If Not Cel Is Nothing Then
 
        Adr = Cel.Address
 
        Do
            'et si dans la colonne Q de la meme ligne je retrouve le mot "triste"
            If Cel.Offset(, 16).Value = cle_deux.Value Then
 
                'Alors les colonnes B, E, G, H et M de la ligne trouvée doivent être collée dans la feuille 2,a partir de la cellule B8
                WsConsultation.Cells(DerLgnWsConsul, 2) = Cel.Offset(, 1).Value
                WsConsultation.Cells(DerLgnWsConsul, 5) = Cel.Offset(, 4).Value
                WsConsultation.Cells(DerLgnWsConsul, 7) = Cel.Offset(, 6).Value
                WsConsultation.Cells(DerLgnWsConsul, 8) = Cel.Offset(, 7).Value
                WsConsultation.Cells(DerLgnWsConsul, 13) = Cel.Offset(, 12).Value
 
                DerLgnWsConsul = DerLgnWsConsul + 1
 
            'Si dans la colonne Q je retrouve le mot "heureux"
            ElseIf Cel.Offset(, 16).Value = cle_trois.Value Then
 
                'alors les colonnes B, E,G,H et M doivent être collées dans la feuille 3 a partir de la ligne 8,col B.
                WsRecherche.Cells(DerLgnWsRech, 2) = Cel.Offset(, 1).Value
                WsRecherche.Cells(DerLgnWsRech, 5) = Cel.Offset(, 4).Value
                WsRecherche.Cells(DerLgnWsRech, 7) = Cel.Offset(, 6).Value
                WsRecherche.Cells(DerLgnWsRech, 8) = Cel.Offset(, 7).Value
                WsRecherche.Cells(DerLgnWsRech, 13) = Cel.Offset(, 12).Value
 
                DerLgnWsRech = DerLgnWsRech + 1
 
            End If
 
            Set Cel = Plage.FindNext(Cel)
 
        Loop While Adr <> Cel.Address
 
    End If
 
End Sub

Hervé.

**patricktoulon** · 14/09/2014, 10h18

bonjour

effectivement c'est pas tres beau

si je comprend bien tu a trois sheets
dans l'un tu veux controler chaque ligne sur 2 colonne bien distinctes et selon la valeurs des deux cellules copier certaines cellules de la ligne dans un sheets ou l'autre

tu n'a qua t'inspirer d'un sujet similaire en terme de copie de cellules non contiguës ICI j'ai donner une réponse simple et relativement courte en terme de ligne de code

mais sur x00000 lignes j'utiliserais des variables tableau moi a ta place

exemple
dans un sheets( 1) .range("A1:d4") tu a

toto 25 ans brun marrant

titi 32 ans blond triste

riri 20 ans brun rigolo

toto 27 ans blond triste

on met tout les toto dans le sheets 2 et le reste dans le sheets(3)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
dim tablo as variant ,i as long 
tablo=sheets(1).range("A1:d4")
for i= lbound(tablo) to ubound(tablo)
if tablo(i,0) ="toto" then 
with sheets(2)
.range("A" & .range("A" & rows.count).end(xlup).row+1).resize(1,4)=sheets(1).range("A" & i+1 &":d" & i+1)
end with 
else 
with sheets(3)
.range("A" & .range("A" & rows.count).end(xlup).row+1).resize(1,4)=sheets(1).range("A" & i+1 &":d" & i+1)
end with 
end if

dans les conditions tu peut soit en ajouter soit les modifier

exemple je peut tester le prénom et la couleur de cheveux

Code :

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

if tablo(i,0) ="toto" and tablo(i,2)="brun" then ........

attention dans le transfert je met "i+1" car les variables tableau commence par 0 pour le premier items
ensuite si ta plage ne commence pas a la ligne 1 il faudra adapter le "i+1"

enfin bref il faudrait que tu donne un exemple de 3 sheets le premier avec tout ,le deuxième avec ce qu'il doit recevoir et le troisième avec ce qu'il doit recevoir aussi
pour ce genre d'exercice on peut réduire le code a moins de 15 lignes

**pruneenurp** · 15/09/2014, 18h01

Hervé, ça marche incroyablement bien!!!
Je me penchee dessus pour en comprendre la logique.

Je comprends du coup pourquoi on me disait de chercher sur une plage et non par cellule...mon cerveau refusait d'intégrer le principe. et je ramais un peu beaucoup!

MERCI!!!!

**pruneenurp** · 15/09/2014, 18h03

Patrick,
Comme l'objectif c'est aussi d'apprendre ... je me penche sur ton lien et essaie de réappliquer.
Merci pour ton aide.

For"if and if"next - Mes ifs indiquent une incompatibilité de type?

Macros et VBA Excel

Partager

Partager