Discussion :

[exqo77]

Bonjour,

J'ai une macro Excel qui me récupère des données d'une base de données vers une feuille Excel "temporaire", et j'aimerai récupérer certaines lignes dont la colonne C est identiques à ces lignes.

Ex :

eXqO 35 Moi
eXqO2 45 Moi
BiBi 25 Toi
...

Le but est de récupérer les lignes 1 et 2 qui ont "Moi" en commun en colonne C.

Cordialement,
eXqO

[CRACOS38]

Salut,
http://msdn.microsoft.com/fr-fr/libr...8VS.80%29.aspx

[laetitia]

bonjour exqo77 CRACOS38 le forum
un exemple avec LIKE

Code :

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

1
2
3
4
5
6
7
8
9
10
Option Explicit
Option Compare Text
Sub es()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("c1", Range("c65536").End(xlUp))
If c Like "*moi*" Then
c.EntireRow.Copy Destination:=Sheets("temporaire").Range("A65536").End(xlUp)(2)
End If: Next c
 End Sub

[Krovax]

Mon grain de sel

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
Option Explicit
Option Compare Text
Sub es()
Dim i as integer
dim j as integer
dim derniereligne as integer
dim flag as boolean
 
Application.ScreenUpdating = False
 
with worksheets("temporaire")
DerniereLigne = .Range("A65536").End(xlUp).Row
For i= 2 to derniereligne -1
   flag=false
   if  .cells(i,1)<>""
     for j =i+1 to derniereligne 
        if .cells(i,3)=.cells(j,3) then
           flag=true
          .cells(j,3).EntireRow.Copy Destination:=Sheets("Travail").Range("A65536").End(xlUp)(2) 'je suppose que cette parti de code de laetitia fonctionne
          .cells(j,3).EntireRow.clearcontents
         End If
     next j
   if flag then
      .cells(i,3).EntireRow.Copy Destination:=Sheets("Travail").Range("A65536").End(xlUp)(2)
   end if
   end if
next i
end with
 End Sub

En gros tu parcour les lignes variable i
si la ligne nest pas vide tu parcour les lignes suivante (variable j)
si ligne i et ligne j ont la meme valeur en colonne 3 alors
on copie la ligne j
on efface la ligne j
quand on a comparé toutes les ligne suivante si on a trouvé au moins une valeur on copie la ligne i

[exqo77]

Merci beaucoup pour votre aide !

Voilà où j'en suis arrivé, le résultat me satisfait mais est-ce optimisé...je pense que oui mais à vérifier quand même ^^

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
For Ligne = 1 To result
        Sheets("Feuil1").Select
        Range("C" & Ligne).Select
        If ActiveCell.FormulaR1C1 = "Mot" Then
            Range("A" & Ligne).Select
            Selection.Copy
            Sheets("Semaine " & i).Select
            Range("A" & Ligne + 4).Select
            ActiveSheet.Paste
            Sheets("Feuil1").Select
            Range("B" & Ligne).Select
            Selection.Copy
            Sheets("Semaine " & i).Select
            Range("B" & Ligne + 4).Select
            ActiveSheet.Paste
        End If
Next

[Krovax]

Juste les select c'est vraiment pas top (tu t'en rendra vite compte )

Code :

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

1
2
3
            Sheets("Feuil1").Select
            Range("B" & Ligne).Select
            Selection.Copy

devient

Code :

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

1
2
 
            Sheets("Feuil1").Range("B" & Ligne).Copy

Sur le gros code ca te fera gagné beaucoup de temps