Recherche de plusieurs occurrences d'une valeur dans un tableau

Le
swoolj
Bonjour,

N’étant pas un pro de Excel, j’aurais besoin d’un coup de main pour avoir la
trame d’une macro.

J’ai un tableau de n lignes avec :
- En colonne A des dates
- En colonne E de 0 à plusieurs occurrences de la valeur à chercher (par
exemple swoolj)
- En colonne G de 0 à plusieurs occurrences de la valeurs à chercher
- En colonne J de 0 à plusieurs occurrences de la valeurs à chercher
- etc…….. sur plusieurs colonnes non juxtaposées

Je souhaite disposer d’une macro me permettant :
- D’abord pouvoir saisir la valeur à chercher sur le principe de « contient
» disponible dans les filtres textuels
- Rechercher la valeur dans toute la colonne E et ramener dans une nouvelle
feuille la valeur de la colonne A (date) correspondante, ainsi que la valeur
de la colonne E elle-même.
- De même pour G, J, M, P, S, V
- Trier à la fin les valeurs trouvées par date
- En cas de valeur non trouvée, message « aucune valeur trouvée »

Il faut ensuite pouvoir supprimer manuellement la feuille de résultat et
lancer une nouvelle recherche

Merci pour votre aide
Cordialement
Swoolj
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
michdenis
Le #21647981
Bonjour,

Essaie ceci en adaptant le nom des feuilles.

Dans l'exemple : les données sont en feuil2
Ligne d'étiquettes en A1

Les résultats sont en Feuil3

'-------------------------------
Sub test()
Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet

'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("Feuil3")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("E", "G", "J", "M", "P", "S", "V")

On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Feuil2")
DerLig = .Range("A:V").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:V" & DerLig)
End With

Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Feuil2.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)

.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If
End Sub
'-------------------------------



"swoolj" discussion :
Bonjour,

N’étant pas un pro de Excel, j’aurais besoin d’un coup de main pour avoir la
trame d’une macro.

J’ai un tableau de n lignes avec :
- En colonne A des dates
- En colonne E de 0 à plusieurs occurrences de la valeur à chercher (par
exemple swoolj)
- En colonne G de 0 à plusieurs occurrences de la valeurs à chercher
- En colonne J de 0 à plusieurs occurrences de la valeurs à chercher
- etc…….. sur plusieurs colonnes non juxtaposées

Je souhaite disposer d’une macro me permettant :
- D’abord pouvoir saisir la valeur à chercher sur le principe de « contient
» disponible dans les filtres textuels
- Rechercher la valeur dans toute la colonne E et ramener dans une nouvelle
feuille la valeur de la colonne A (date) correspondante, ainsi que la valeur
de la colonne E elle-même.
- De même pour G, J, M, P, S, V
- Trier à la fin les valeurs trouvées par date
- En cas de valeur non trouvée, message « aucune valeur trouvée »

Il faut ensuite pouvoir supprimer manuellement la feuille de résultat et
lancer une nouvelle recherche

Merci pour votre aide
Cordialement
Swoolj
swoolj
Le #21651191
Merci pour ton aide; Je vais encore en avoir besoin ;-)

J’ai adapté comme j’ai pu mais le miracle ne s'est pas produit et je n’ai
pas le bon résultat.
- Dans la colonne « Les dates », j’ai bien des dates de la colonne A de la
feuille "Planning", mais beaucoup trop (j'ai 28 à 29 fois la même alors que
compte tenu de mes données seules quelques redondances sont possibles); De
plus elles ne sont pas au format date mais en numéro de série
- Dans la colonne « Résultat » je n’ai rien du tout alors que je cherche à
récupérer le texte complet des valeurs correspondants au critère qui se
trouvent dans les colonnes "Intervenant XX"

Voici par exemple ce qu’il faudrait obtenir en saisissant « Eric » dans le
filtre textuel de type Contient :
Les dates Résultat
mercredi 05/05/2010 Jm. Eric (extrait de la colonne "Intervenant A1" dans
la feuille "Planning")
jeudi 06/05/2010 JMarc Eric (extrait de la colonne "Intervenant B1" dans la
feuille "Planning")
mercredi 12/05/2010 JM. Eric (extrait de la colonne "Intervenant B1" dans
la feuille "Planning")
jeudi 13/05/2010 JM Eric (extrait de la colonne "Intervenant B1" dans la
feuille "Planning")
mercredi 19/05/2010 JM. Eric (extrait de la colonne "Intervenant A1" dans
la feuille "Planning")
jeudi 20/05/2010 JM. ERIC (extrait de la colonne "Intervenant B2" dans la
feuille "Planning")
mercredi 26/05/2010 JMa Eric (extrait de la colonne "Intervenant D1" dans
la feuille "Planning")
vendredi 28/05/2010 JM. Eric (extrait de la colonne "Intervenant C2" dans
la feuille "Planning")

Voici mon code :
Sub RechercheIntervenant()

Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet

'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("DatesIntervenant")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("Intervenant A1", "Intervenant B1", "Intervenant C1", _
"Intervenant D1", "Intervenant A2", "Intervenant B2", "Intervenant C2")

On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Planning")
DerLig = .Range("A:W").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:W" & DerLig)
End With

Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Planning.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)

.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, Header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If

End Sub

----------------------------------------------------------------
"michdenis" a écrit :

Bonjour,

Essaie ceci en adaptant le nom des feuilles.

Dans l'exemple : les données sont en feuil2
Ligne d'étiquettes en A1

Les résultats sont en Feuil3

'-------------------------------
Sub test()
Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet

'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("Feuil3")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("E", "G", "J", "M", "P", "S", "V")

On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Feuil2")
DerLig = .Range("A:V").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:V" & DerLig)
End With

Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Feuil2.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)

.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If
End Sub
'-------------------------------



"swoolj" discussion :
Bonjour,

N’étant pas un pro de Excel, j’aurais besoin d’un coup de main pour avoir la
trame d’une macro.

J’ai un tableau de n lignes avec :
- En colonne A des dates
- En colonne E de 0 à plusieurs occurrences de la valeur à chercher (par
exemple swoolj)
- En colonne G de 0 à plusieurs occurrences de la valeurs à chercher
- En colonne J de 0 à plusieurs occurrences de la valeurs à chercher
- etc…….. sur plusieurs colonnes non juxtaposées

Je souhaite disposer d’une macro me permettant :
- D’abord pouvoir saisir la valeur à chercher sur le principe de « contient
» disponible dans les filtres textuels
- Rechercher la valeur dans toute la colonne E et ramener dans une nouvelle
feuille la valeur de la colonne A (date) correspondante, ainsi que la valeur
de la colonne E elle-même.
- De même pour G, J, M, P, S, V
- Trier à la fin les valeurs trouvées par date
- En cas de valeur non trouvée, message « aucune valeur trouvée »

Il faut ensuite pouvoir supprimer manuellement la feuille de résultat et
lancer une nouvelle recherche

Merci pour votre aide
Cordialement
Swoolj

michdenis
Le #21656791
Je t'explique ce que fait la macro :

Elle applique un filtre automatique à tour de rôle sur les
colonnes que tu as mentionnées : "E", "G", "J", "M", "P", "S", "V"
en utilisant le critère que tu saisis dans le InputBox().

Après chacun des filtres sur chacune des colonnes, elle recopie
les données obtenues dans la colonne A:A pour les dates + les
données dans la colonne filtrée dans l'autre feuille.

Si tu désires autre chose, il faudrait être claire dans ta demande parce
que moi, je n'ai pas saisi ce que tu désirais obtenir !






"swoolj" discussion :
Merci pour ton aide; Je vais encore en avoir besoin ;-)

J’ai adapté comme j’ai pu mais le miracle ne s'est pas produit et je n’ai
pas le bon résultat.
- Dans la colonne « Les dates », j’ai bien des dates de la colonne A de la
feuille "Planning", mais beaucoup trop (j'ai 28 à 29 fois la même alors que
compte tenu de mes données seules quelques redondances sont possibles); De
plus elles ne sont pas au format date mais en numéro de série
- Dans la colonne « Résultat » je n’ai rien du tout alors que je cherche à
récupérer le texte complet des valeurs correspondants au critère qui se
trouvent dans les colonnes "Intervenant XX"

Voici par exemple ce qu’il faudrait obtenir en saisissant « Eric » dans le
filtre textuel de type Contient :
Les dates Résultat
mercredi 05/05/2010 Jm. Eric (extrait de la colonne "Intervenant A1" dans
la feuille "Planning")
jeudi 06/05/2010 JMarc Eric (extrait de la colonne "Intervenant B1" dans la
feuille "Planning")
mercredi 12/05/2010 JM. Eric (extrait de la colonne "Intervenant B1" dans
la feuille "Planning")
jeudi 13/05/2010 JM Eric (extrait de la colonne "Intervenant B1" dans la
feuille "Planning")
mercredi 19/05/2010 JM. Eric (extrait de la colonne "Intervenant A1" dans
la feuille "Planning")
jeudi 20/05/2010 JM. ERIC (extrait de la colonne "Intervenant B2" dans la
feuille "Planning")
mercredi 26/05/2010 JMa Eric (extrait de la colonne "Intervenant D1" dans
la feuille "Planning")
vendredi 28/05/2010 JM. Eric (extrait de la colonne "Intervenant C2" dans
la feuille "Planning")

Voici mon code :
Sub RechercheIntervenant()

Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet

'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("DatesIntervenant")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("Intervenant A1", "Intervenant B1", "Intervenant C1", _
"Intervenant D1", "Intervenant A2", "Intervenant B2", "Intervenant C2")

On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Planning")
DerLig = .Range("A:W").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:W" & DerLig)
End With

Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Planning.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)

.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, Header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If

End Sub

----------------------------------------------------------------
"michdenis" a écrit :

Bonjour,

Essaie ceci en adaptant le nom des feuilles.

Dans l'exemple : les données sont en feuil2
Ligne d'étiquettes en A1

Les résultats sont en Feuil3

'-------------------------------
Sub test()
Dim Rg As Range, DerLig As Long
Dim Arr(), Sh As Worksheet

'Feuille de destination des données
'Nom Feuille à adapter
Set Sh = Worksheets("Feuil3")
Sh.Range("A1") = "Les dates"
Sh.Range("B1") = "Résultat"
Arr = Array("E", "G", "J", "M", "P", "S", "V")

On Error Resume Next
'où sont les données - nom feuille à adapter
With Worksheets("Feuil2")
DerLig = .Range("A:V").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rg = .Range("A1:V" & DerLig)
End With

Do
critère = Application.InputBox("Critère à appliquer " & _
"pour le filtre ?", Type:=2)
If Format(critère) = False Then
MsgBox "opération annulée."
Exit Sub
End If
Loop Until critère <> ""
If critère <> "" Then
Application.ScreenUpdating = False
For Each elt In Arr
Feuil2.ShowAllData
ligne = Sh.Range("a65536").End(xlUp)(2).Row
With Rg
.AutoFilter Field:=.Cells(1, elt).Column, Criteria1:=critère
If Application.Subtotal(3, Columns(elt)) - 1 > 0 Then
.Columns(1).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Range("A" & ligne)

.Columns(elt).Offset(1).Resize(Rg.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sh.Cells(ligne, 2)
End If
End With
Next
Sh.Range("A:A").Sort Key1:=Sh.Range("A2"), _
order1:=xlAscending, header:=xlYes
Sh.Range("A:B").ClearFormats
Rg.AutoFilter
Application.ScreenUpdating = True
End If
End Sub
'-------------------------------



"swoolj" discussion :
Bonjour,

N’étant pas un pro de Excel, j’aurais besoin d’un coup de main pour avoir la
trame d’une macro.

J’ai un tableau de n lignes avec :
- En colonne A des dates
- En colonne E de 0 à plusieurs occurrences de la valeur à chercher (par
exemple swoolj)
- En colonne G de 0 à plusieurs occurrences de la valeurs à chercher
- En colonne J de 0 à plusieurs occurrences de la valeurs à chercher
- etc…….. sur plusieurs colonnes non juxtaposées

Je souhaite disposer d’une macro me permettant :
- D’abord pouvoir saisir la valeur à chercher sur le principe de « contient
» disponible dans les filtres textuels
- Rechercher la valeur dans toute la colonne E et ramener dans une nouvelle
feuille la valeur de la colonne A (date) correspondante, ainsi que la valeur
de la colonne E elle-même.
- De même pour G, J, M, P, S, V
- Trier à la fin les valeurs trouvées par date
- En cas de valeur non trouvée, message « aucune valeur trouvée »

Il faut ensuite pouvoir supprimer manuellement la feuille de résultat et
lancer une nouvelle recherche

Merci pour votre aide
Cordialement
Swoolj

Publicité
Poster une réponse
Anonyme