Discussion :

[JiBé91]

Bonjour à tous,

j'ai une macro rapide a rédiger mais je bloque sur un point.

Ci dessous la macro:

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
Sub MAIN()
Dim i As Long
Dim Entree As Workbook
Dim Plage As Range
Const Fichier As String = "C:\Documents and Settings\user\Bureau\GPS\COMMANDE_ELEMENT petite liste.xls"
 
Application.ScreenUpdating = False
If Dir(Fichier) <> "" Then
    Set Entree = Workbooks.Open(Fichier)
    With Entree.Sheets("COMMANDE_ELEMENT")
 
        For i = 2 To 25000
 
            RECHERCHE Entree, .Range("F" & i)
 
        Next i
 
    End With
    Entree.Close True
    Set Entree = Nothing
 
End If
 
 
End Sub
 
Private Sub RECHERCHE(ByVal Wbk As Workbook, ByVal c As Range)
 
 
 
If c.Value = "CONTENEUR" Then
 
    With ThisWorkbook.Worksheets("RESULTAT")
    .Rows(2).Insert shift:=xlDown
    .Range("A2").Value = c.Offset(0, -5).Value
    .Range("B2").Value = c.Offset(0, -3).Value
    .Range("C2").Value = c.Offset(0, 12).Value
    .Range("D2").Value = c.Offset(0, 13).Value
    .Range("E2").Value = c.Offset(0, 0).Value
    End With
 
End If
 
End Sub

Dans cette macro, les cellules vont etre copiées si le contenue de la cellule "c" est "CONTENEUR" or je voudrais que les cellules soient copiées si la cellule "c" contient le mont "CONTENEUR".

Autrement dit, à partir du moment ou dans la cellule il y a le mot "CONTENEUR", qu'il soit précédé ou non de d'autres terme la macro doit s'éxécutée.

est ce possible?

Cordialement

[Kimy_Ire]

Je crois qu'un post vient d'être ouvert pour une question similaire :
http://www.developpez.net/forums/d12...fonction-find/

[JiBé91]

merci, je jette un oeil.

Je viens de decouvrir qu'il y avait une fonction find certainement plus appropriée pour ma requette. Mais je n'arrive pas a l'intégrer...

[goldstar]

Bonjour,

A adapter

Code :

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

1
2
3
4
5
6
7
8
9
10
 
 
Mot=”CONTENEUR”
 
For i = 2 To 25000
     Set c = Sheets("COMMANDE_ELEMENT").Cells(i, 3).Find(Mot)
     If Not c Is Nothing Then 'Si il trouve le Mot
         'Copier le texte
     End If
next i

[Kimy_Ire]

A la place de ta fonction RECHERCHE je te propose quelque chose du genre que je viens de trouver sur le net :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub find2()
 
With Worksheets("feuil1")
    For i = 0 To 25000
        Set cell = .Range("F1").Offset(i, 0)
        If InStr(1, cell, "CONTENEUR") Then
            'Si le mot "CONTENEUR" est partiellement dans la cellule alors place "YES!" à droite de celle-ci
            cell.Offset(0, 1) = "YES!"
        End If
    Next i
End With
End Sub

[JiBé91]

Hier soir je saturais alors j'ai préféré reculer pour mieux sauter.

Ce matin j'ai pris 5 min pour ré-écrire proprement le code et ça marche:

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
Sub RECHERCHE()
Dim i As Long
Dim Entree As Workbook
Dim Plage As Range
Dim mot As String
Const Fichier As String = "C:\Documents and Settings\user\Bureau\GPS\COMMANDE_ELEMENT petite liste.xls"
 
mot = "CONTENEUR"
Application.ScreenUpdating = False
If Dir(Fichier) <> "" Then
Set Entree = Workbooks.Open(Fichier)
    With Entree.Sheets("COMMANDE_ELEMENT")
        For i = 2 To 25000
            Set c = Sheets("COMMANDE_ELEMENT").Cells(i, 6).Find(mot)
            If Not c Is Nothing Then
                With ThisWorkbook.Worksheets("RESULTAT")
                .Rows(2).Insert shift:=xlDown
                .Range("A2").Value = c.Offset(0, -5).Value
                .Range("B2").Value = c.Offset(0, -3).Value
                .Range("C2").Value = c.Offset(0, 12).Value
                .Range("D2").Value = c.Offset(0, 13).Value
                .Range("E2").Value = c.Offset(0, 0).Value
                End With
            End If
        Next i
    End With
Entree.Close True
Set Entree = Nothing
End If
 
End Sub

Merci à vous.

Cordialement