[VBA-E] recherche dans un tableau

**tibss** · 28/04/2006, 16h00

Pour l'instant, le pgm donne :

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
Sub Macro1()
'
 
Dim Message As String
Dim Plage as Range
 
'Crée une boîte de dialogue :
Message = InputBox(" Entrez la date : ", "Mon Programme", "01/mm/aaaa")
 
'Arrête procédure si utilisateur clique sur annuler
If Message = "" Then Exit Sub
 
Set Plage = ActiveCell.CurrentRegion
With Plage
.Find(What:=Message, After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
End With
Set Plage = Nothing
'
End Sub

Lorsque je rempli mon tableau et que j'y met des dates, ej les met sous la forme : 01/02/2005, 01/07/2005, 01/09/2005. Ainsi, dans le tableau excel ces dates figurent sous la forme févr-2005, juillet-2005, spt-2005...

Lorsque que je ferai ma recherche pour févr-2005 il faudra donc que je recherche 01/02/2005 et non pas févr-2005.

Le pbm, c'est qu'avec ce programme, je ne peux pas sélectionner les dates de type : 01/02/2005.

Et ej en sais pas pkoi cela n emarche pas

est ce que cette précision éclaire votre vision des choses?

**ouskel'n'or** · 28/04/2006, 16h14

Faut-il tout te dire ?
Essaie d'extrapoler les pistes qu'on te donne

Envoyé par tu

Ainsi, lorsqu’on fait une recherche, il faut rechercher 01/02/2005 et non pas févr-2005.

Je te donne le moyen de formater la date saisie comme elle est dans la feuille. Dans l'exemple, cette date, je la mets dans la variable message.
Ne peux-tu pas imaginer la saisie d'une date dans un inputbox avant qu'elle soit formatée comme tu le désires ?
On ne peut pas faire le travail à ta place.
On te donne des pistes et il me semble qu'on t'en a données pas mal, à toi d'essayer d'adapter.
C'est tout de même un minimum que tu peux faire

Pour connaître la dernière ligne de ton tableau, en recherche, tu peux tester que le numéro de la dernière ligne trouvée n'est pas inférieur au numéro de la précédente. S'il est inférieur c'est que la recherche a redémarré depuis le haut
C'est une solution. Il y en a une autre que j'ai oubliée mais tu auras certainement une réponse sous peu

A+

inférieur ou égal, le numéro de ligne

**tibss** · 28/04/2006, 19h17

Excuse moi Ouskel'n'or, peut être ai-je mal compris ce que tu m'as dit. Ce que je voulais dire, c'est qu'en tous les cas il en faut pas rechercher la date selon la manière où elle apparait dans le tableau (ex : févr-2005), mais selon la manière dont on l'a rentrée dans le tableau (ex : 01/02/2005). Car la valeur de la cellule reste celle que l'on a rentrée dans le tableau.

Donc je ne sais pas si tu vois ce que ej veux dire, peut être ne t'ai je pas bien compris, je pensais que lede pgm que tu me proposais permettais de faire la recherche selon la manière dont la date apparait dans le tableau...

désolé si je t'ai par la même agacé...

a+

**ouskel'n'or** · 29/04/2006, 00h39

Pas de bobo, je vais t'expliquer, je reprends mon code
Je suppose que tu recherche la date "01 02 2005"
Je crée une variable message as date mais tu peux simplifier, je t'expliquerai ensuite

Dim message As Date
LaDate = "01-" + "Févr-2005" ' donne "01-Févr-2005"
message = Format(CDate(LaDate), "dd mm yyyy") ' donne "01 02 2005"
MsgBox message 'ce n'était que pour que vois le résultat

Pour que ça corresponde à ta demande, je prends toujours la même date mais je change le format des séparateurs ("/")

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
Sub RechercheDuneDate()
Dim message As Date, Plage, LaDate
    LaDate = InputBox("Saisir la date à rechercher", "SAISIE DE LA DATE", "jj/mm/aaaa")
    If Not IsDate(LaDate) Then Exit Sub 'vérifie que la saisie est bien une date
    'Je suppose que la date a été saisie sous une autre forme (ex. 01-02-2005) mais tu cherches 01/02/2005
    'Tu dois formater ta date
    message = CVar(Format(CDate(LaDate), "dd/mm/yyyy")) ' donne "01/02/2005")
    'Maintenant tu peux faire une recherche sur la date formatée comme sur ta feuille
    Plage = Cells(1, 1).CurrentRegion.Address
    With Worksheets("Feui1").Range(Plage)
        'Je cherche la première occurence AVANT de rentrer dans une éventuelle boucle de recherche des données suivantes
        Set Cestla = .Find(message, LookIn:=xlValues, LookAt:=xlPart)
        If Not Cestla Is Nothing Then   'si je trouve, je note les coordonnées de la 1ère occurence (Cestla.address)
                MsgBox Cestla.Address 
                'Affiche l'adresse de la cellule contenant la date cherchée
                Rows(Range(CestLa.Address).Row).EntireRow.Copy Worksheets("Feuil4").Rows(2)
                'Copie la ligne trouvée dans Feuil1, ligne 2 dans feuil4, 
                'remplace le contenu de la ligne (n'insère pas une nouvelle ligne)
            Else
                MsgBox "Date inexistante"
        End If
    End With
    Set Cestla = Nothing
End Sub

Pour ta boucle, utilise FindNext. Si tu as un pb, tu dis mais essaie de nous proposer quelque chose

Bon courage

A+

NB - Pense à déclarer toutes les variables. Un variable sans type prend, par défaut, le type variant. Or une variant s'adapte au 1er usage que tu en fais. Donc, tu peux parfaitement mettre "Dim Plage" sans indiquer le type. Ceci pour corriger ce qui t'a été dit par ailleurs.

**tibss** · 02/05/2006, 14h31

Merci Ouskel'n'or, j'ai lu ta réponse avec attention, et j'ai réussi grâce à ton aide à voir où se situait le pbm de ma recherche avec la fonction .find. En fait il me fallait formater la date, en utilisant : message = CVar(Format(CDate(LaDate), "dd/mm/yyyy")).

Désormais, la recherche avec la fonction .find marche donc, et il va me faloir étendre cette recherche à tous les éléments recherchés du tableau. Pour ce faire, j'ai pensé à un do while, et je te montre ce que le tout donne :

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
 
 
Dim message As Date, Plage, LaDate
 
 
Do
    LaDate = InputBox("Saisir la date à rechercher", "SAISIE DE LA DATE", "jj/mm/aaaa")
    If Not IsDate(LaDate) Then Exit Sub 'vérifie que la saisie est bien une date
    'si la date a été saisie sous une autre forme (ex. 01-02-2005) mais qu'on cherche 01/02/2005
    'on doit formater la date
    message = CVar(Format(CDate(LaDate), "dd/mm/yyyy")) ' donne "01/02/2005")
    'recherche sur la date formatée comme sur la feuille
    Set Plage = ActiveCell.CurrentRegion
        With Plage
            .Find(What:=message, After:=ActiveCell, LookIn:=xlFormulas _
            , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False).Activate
        End With
    Set Plage = Nothing
 
 
    'sélection de toute la ligne
    Selection.EntireRow.Select
 
 
    'recopie de la ligne sur la fuille n°2
    'permet de copier et coller une ligne sur une autre feuille
    Selection.Copy
    Sheets("Feuil2").Select
    k = ActiveSheet.UsedRange.SpecialCells(xlLastCell).End(xlToLeft).Row + 1
    Cells(k, 1).Select
    ActiveSheet.Paste
 
 
    'supprime les lignes vides dans une plage.
    Sheets("feuil2").Select
    DerniereLigne = ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For R = DerniereLigne To 1 Step -1
        If Application.CountA(Rows(R)) = 0 Then Rows(R).Delete
    Next R
 
 
    'permet de resélectionner la dernière cellule sélectionnée (afin de pouvoir réexécuter une nouvelle recherche à partir de l'endroit précédent)
Sheets("feuil1").Select
        Set Plage = ActiveCell.CurrentRegion
        With Plage
        .Find(What:=message, After:=ActiveCell, LookIn:=xlFormulas _
            , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False).Activate
        End With
    Set Plage = Nothing
 
'boucle "tant que message= valeur dans la cellule sélectionnée, recommence la recherche"
Loop While message = ActiveCell.Value

Lorsque que j'exécute cette fonction sans la boucle "do while", la ligne contenant le mot recherché est sélectionnée puis recopiée dans la feuille 2. Lorsque que je ré exécute la macro, la ligne suivante contenant elle aussi le mot recherchée est sélectionnée puis recopiée. Au fur et à mesure que je continue d'exécuter manuellement la macro, toutes le lignes du tableau contenant le mot recherché sont une à une sélectionnées et recopiées dans la feuille n°2.

La boucle « do while » que j’ai écrite devrait donc me permettre d'automatiser cette recherche, en appliquant automatiquement le pgm à toutes les lignes contenant le mot recherché ; ce qui n’est pas le cas.
Y a –t-il une erreur dans ma boucle ? :o(

**ouskel'n'or** · 02/05/2006, 15h10

Hello me revoilou,
Je t'ai donné cette syntaxe qui évite les Select et le passage d'une feuille dans l'autre :

Code :

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

1
2
3
4
 
                Rows(Range(CestLa.Address).Row).EntireRow.Copy Worksheets("Feuil4").Rows(2)
                'Copie la ligne trouvée dans Feuil1, ligne 2 dans feuil4, 
                'remplace le contenu de la ligne (n'insère pas une nouvelle ligne)

Application.DisplayAlerts = false "semble" faire la même chose mais les Select ralentissent considérablement ton code.
Enfin, ce code est plus simple et évite un passage par la mémoire

Pour supprimer la ligne copiée, et si tu ne fais pas de Select, tu te trouves toujours dans la même feuille. Tu n'as donc pas à la désigner pour inclure, après copie

Code :

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

    Rows(Range(CestLa.Address).Row).Delete Shift:=xlUp

Enfin, si tu n'appliques pas le code qu'on te donne, les réponses risquent de ne plus correspondre.

Les histoires de sélectionner une feuille
1 - puis une ligne
2 - puis de copier sur une feuille
3 - puis sélectionner une autre feuille
4 - puis de sélectionner une ligne
5 - puis de coller la ligne copiée
6 - puis de revenir sur la première feuille
7 - puis de sélectionner la ligne
8 - puis de la supprimer
ces huit étapes sont fournies par l'enregistreur de macro qui fait ce que tu as fait manuellement mais qui ne sait pas simplifier le code.
Ce qu'on te propose sert précisément à ça

Et tu peux le faire sur deux lignes... C'est mieux que huit, non ?

Essaie de faire ça, tu verras la satisfaction que tu en éprouveras... Et ensuite tu sauras faire

Une dernière chose, je ne comprends pas ce que tu veux faire là :

Envoyé par Tu

k = ActiveSheet.UsedRange.SpecialCells(xlLastCell).End(xlToLeft).Row + 1

Tu dis

A+

**tibss** · 02/05/2006, 15h50

En fait Ouskel'n'or, j'ai essayé d'utiliser ton code pour effectuer une recherche :

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
 
Dim message As Date, Plage, LaDate
    LaDate = InputBox("Saisir la date à rechercher", "SAISIE DE LA DATE", "jj/mm/aaaa")
    If Not IsDate(LaDate) Then Exit Sub 'vérifie que la saisie est bien une date
    'Je suppose que la date a été saisie sous une autre forme (ex. 01-02-2005) mais tu cherches 01/02/2005
    'Tu dois formater ta date
    message = CVar(Format(CDate(LaDate), "dd/mm/yyyy")) ' donne "01/02/2005")
    'Maintenant tu peux faire une recherche sur la date formatée comme sur ta feuille
    Plage = Cells(1, 1).CurrentRegion.Address
    With Worksheets("Feui1").Range(Plage)
        'Je cherche la première occurence AVANT de rentrer dans une éventuelle boucle de recherche des données suivantes
        Set Cestla = .Find(message, LookIn:=xlValues, LookAt:=xlPart)
        If Not Cestla Is Nothing Then   'si je trouve, je note les coordonnées de la 1ère occurence (Cestla.address)
                MsgBox Cestla.Address
                'Affiche l'adresse de la cellule contenant la date cherchée
                Rows(Range(Cestla.Address).Row).EntireRow.Copy Worksheets("Feuil4").Rows(2)
                'Copie la ligne trouvée dans Feuil1, ligne 2 dans feuil4,
                'remplace le contenu de la ligne (n'insère pas une nouvelle ligne)
            Else
                MsgBox "Date inexistante"
        End If
    End With
    Set Cestla = Nothing

Le problème est que lrosque je lance une recherche en applicant ce code, cela me renvoie un message d'erreur qui est : "L'indice n'appartient pas à la sélection".
Lorsque je lance le débogage, je me rends compte que l'erreur concerne la ligne :

Code :

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

With Worksheets("Feui1").Range(Plage)

C'est pourquoi, ne sachant pas résorber ce problème

, et ne voulant pas te déranger , j'ai du faire appel à mon code qui est assez lourd lol .

Sinon,

Code :

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

1
2
 
k = ActiveSheet.UsedRange.SpecialCells(xlLastCell).End(xlToLeft).Row + 1

permet de recopier la ligne sélectionnée dans la nouvelle feuille active, et cela implémente automatiquement la ligne de +1 afin de ne pas recopier la ligne sélectionnée sur une ligne déjà existente.
(le but étant de faire apparaitre toutes les lignes contenant l'élément recherché sur la feuille où s'effectue la recopie).

**ouskel'n'or** · 02/05/2006, 17h18

Ok pour la ligne suivante :

k = ActiveSheet.UsedRange.SpecialCells(xlLastCell).End(xlToLeft).Row + 1

Je reviendrai dessus plus tard (tu n'es pas obligé d'être dans la feuil2 pour avoir le N° de la dernière ligne

Pour le reste :
Dans ton code, tu places le début de la boucle avant la première recherche et, après avoir supprimé une ligne, tu lance une recherche sur une plage qui a changé. Ça ne peut pas marcher.

Sois tu lances une première recherche afin de trouver la première occurence, puis tu rentres dans la boucle, copies la ligne trouvée et continues avec FindNext mais je doute que ça marche, la plage ayant changé... (même problème que + haut)
Soit tu mets la recherche dans la boucle telle que je te l'ai indiquée mais, une fois la ligne supprimée, tu re-définis la plage en fin de boucle, juste avant "Loop While message = ActiveCell.Value"
Donc, tu la définis Une fois avant "Do" et une fois dedans en fin de boucle

Je regarde ce qu'on peut faire avec ton code mais essaie de ton côté
Faut que je bosse un peu (mais tu ne déranges pas, si je ne peux pas répondre, je réponds pas

)

A+

**ouskel'n'or** · 02/05/2006, 17h50

Vite fait, pas testé
Mais là, je compte sur toi

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
 
Sub CopierEtCollerEtSupprimer()
Dim message As Date, Plage, LaDate
    LaDate = InputBox("Saisir la date à rechercher", "SAISIE DE LA DATE", "jj/mm/aaaa")
    If Not IsDate(LaDate) Then Exit Sub 'vérifie que la saisie est bien une date
    'On suppose que la date a été saisie sous une autre forme (ex. 01-02-2005)...
    '... mais on cherche 01/02/2005  -> On doit formater la date
    message = CVar(Format(CDate(LaDate), "dd/mm/yyyy")) ' donne "01/02/2005")
    'Maintenant on peut faire une recherche sur la date formatée comme sur la feuille
    Plage = Cells(1, 1).CurrentRegion.Address
    NouvelleLigne = Worksheets("Feuil2").Cells(65535, 1).End(xlUp).Row + 1
    'Je cherche la première ligne libre de la feuil2 Dernière + 1
    'Fonctionne si la colonne A possède le plus grand nombre de lignes renseignées
    'sinon, tu as CurrentRegion.row On verra plus loin
    Do
        With Worksheets("Feui1").Range(Plage)
            'On cherche la première occurence avant de modifier la plage
            Set CestLa = .Find(message, LookIn:=xlValues, LookAt:=xlPart)
            If Not CestLa Is Nothing Then   
                    'si on trouve, on note les coordonnées de la 1ère occurence (Cestla.address)
                    Rows(Range(CestLa.Address).Row).EntireRow.Copy Worksheets("Feuil2").Rows(NouvelleLigne)
                    'Copie la ligne trouvée dans Feuil1, ligne NouvelleLigne dans feuil2,
                    'remplace le contenu de la ligne (n'insère pas une nouvelle ligne)
                    Rows(Range(CestLa.Address).Row).Delete Shift:=xlUp
                Else
                    MsgBox "Date inexistante"
                    Exit Do 'permet de sortir de la boucle si plus de correspondance
            End If
        End With
        DernièreLigne = Worksheets("Feuil2").Cells(65535, 1).End(xlUp).Row + 1
    'boucle "tant que message= valeur dans la cellule sélectionnée, recommence la recherche"
        Plage = Cells(1, 1).CurrentRegion.Address
        NouvelleLigne = Worksheets("Feuil2").Cells(65535, 1).End(xlUp).Row + 1
    Loop While Not CestLa Is Nothing 
    Set CestLa = Nothing
End Sub

On peut simplifier en utilisant un ofset sur le N° de ligne plutôt que rechercher x fois la première ligne vide mais teste déjà ça

A+

**tibss** · 02/05/2006, 17h58

lol oki merci Ouskel'n'or c sympa en tout cas

je vais regarder de mon côté, j'esper qu'a nous deux on réussira à trouver une soluce

et sinon par rapport au mssg d'erreur lié a ton pgm
t'as une idée?

**ouskel'n'or** · 02/05/2006, 18h05

J'ai testé mon code ! Ne sois pas étonné si ça ne fonctionne pas.
Cherche l'erreur dans ces deux lignes

Do
With Worksheets("Feui1").Range(Plage)

Eh oui,j'ai mis "Feui1" au lieu de "Feuil1"...

C'était déjà le cas dans ma réponse du 28 modifiées le 29/05 !

Tu aurais pu me le dire !

J'avais envie de taper sur quelqu'un et je n'ai que toi sous la main...

Une fois corrigé, ça fonctionne du premier coup sauf une chose :
Si ta feuil2 est vierge au départ, la procédure place la première ligne copiée sur la ligne 2
Si tu as des entêtes de colonne, ça ne pose pas de pb.
Si tu n'as pas d'entête, et que tu veux commencer à la ligne 1, suffit d'initialiser "PremièreLigne = 1" avant la boucle. Tu ne change rien dans la boucle

A+

Tu dis

**tibss** · 03/05/2006, 13h04

Salut Ouskel'n'or,
merci pour le code, je l'ai testé :
cela m erenvoyait au début une erreur pour :

Code :

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

1
2
 
Set CestLa = .Find(message, LookIn:=xlValues, LookAt:=xlPart)

j'ai effectué une petite modif et j'ai changé cette ligne en :

Code :

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

Set Cestla = .Find(message, LookIn:=xlFormulas, LookAt:=xlWhole)

et maintenant le pgm marche on ne peut mieux

.

Le tableau de données que j'ai au début doit rester le même vu qu'il est réutilisé régulièrement. Or, dans le pgrm, les lignes sélectionnées dans ce tableau sont supprimées automatiquement, mais étant donné que la boucle que tu as faite repose sur cette supression (car elle ne s'arrête que lorsque il n'y a plus de date recherchées dans le tableau), modifier cette partie du code aurait encore demandé une modif complète du code.
Donc j'ai créé une page intermédiaire à partir de laquelle je fait une recopie automatique du tableau non modifié, de tel sorte que je retrouve mon tableau inchangé à chaque nouvelle exécution.

Lol, tout cela pour dire que le code marche très bien, et que je te remercie infiniment

. Ca me fait super plaisir, moi qui n'arrivait pas à me débloquer

Maintenant ej vais implémenter à chaque fin de recherche la date de 1 mois et cela 12 fois, afin de pouvoir copier et coller les lignes correspondant aux douze mois d l'année;

. J'ai à peine le temps de souffler

.
Merci encore Ouskel'n'or de m'avoir aider c'est très sympa à toi,
Surement bientôt

**ouskel'n'or** · 03/05/2006, 14h00

Désolé pour la suppression de la ligne copiée, je croyais que c'est ce que tu voulais. J'ai tout relu... j'ai pas trouvé... Donc, j'ai encore lu trop vite.

Une modif est possible en faisant ta première recherche hors de la boucle et en utilisant FindNext dans la boucle... Mais là, tu devras faire un test sur le dernier N° de ligne trouvé car si la donnée cherchée n'existe plus vers la fin de la feuille, FindNext reprend la recherche depuis la première ligne.

C'est toi qui vois

A+

NB - Ne sois pas surpris, je vais faire le ménage des posts inutiles pour clarifier la demande et les réponses. Si tu n'y vois pas d'inconvénient... Tu dis

**tibss** · 03/05/2006, 18h52

Nan, il n'y a pas de pbm pour le ménage Ouskel'n'or

je te remercie encore

bonne soirée
à bientôt

[VBA-E] recherche dans un tableau

Macros et VBA Excel

Discussions similaires

Partager

Partager