Aide macro recherche groupé

[starz]

Bonjour,
Pouvez vous m'aider à résoudre mon problème de macro.
Sur un ancien document j'utilisait cette macro mais elle fonctionnait sur plusieurs feuille, maintenant j'en utilise qu' une seule.

Je souhaite faire une recherche selon un critère "oui" dans ma plage de cellule
(A : D), si dans la colonne D il y a une cellule = oui alors je met le résultat dans ma plage (F:H)

un exemple en pièce jointe pret à recevoir votre aide

merci



ma macro

Option Explicit
Option Compare Text
Sub test()
On Error Resume Next
Dim Ws As Worksheet, x As Variant, i As Integer, j As Integer, k As Integer, T As Variant, T1() As String, n As Variant
n = ActiveSheet.Name
Application.ScreenUpdating = False
 Columns("e:f").ClearContents
For Each Ws In Worksheets
If Ws.Name <> "Feuil1" Then
Worksheets(Ws.Name).Activate
T = Range("A3:c" & Range("b65536").End(xlUp).Row)
x = 1
For i = 1 To UBound(T)
For j = 2 To 2
If T(i, j) = "oui" Then
ReDim Preserve T1(1 To 2, 1 To x)
For k = 1 To 2
T1(k, x) = T(i, k)
Next k: x = x + 1: End If: Next j: Next i
Sheets("Feuil1").Range("a65536").End(xlUp).Offset(1, 0).Resize(UBound(T1, 2)) = [b3]
Sheets("Feuil1").Range("b65536").End(xlUp).Offset(1, 0).Resize(UBound(T1, 2), UBound(T1, 1)) = Application.Transpose(T1)
Erase T, T1: End If: Next Ws: Sheets(n).Activate
End Sub

 

[ChTi160]

Re : Aide macro recherche groupé

Salut starz
Bonjour le Fil
Bonjour le Forum

Voila ce que j'ai mis en fonction de ce que j'ai cru comprendre

Option Explicit
Option Compare Text
Sub test()
On Error Resume Next
Dim x As Long, i As Integer, j As Integer, k As Integer, T As Variant, T1() As String, n As String
n = ActiveSheet.Name
Application.ScreenUpdating = False
 Columns("e:G").ClearContents
With Worksheets("Feuil1")
      .Activate
      .Range("F5:H" & .Range("F65536").End(xlUp).Row + 1).ClearContents 'on efface la plage
T = .Range("A2:D" & .Range("A65536").End(xlUp).Row) 'on récupére le tableau
x = -1
For i = 1 To UBound(T) 'pour chaque ligne du tableau

If T(i, 3) = "oui" Then 'si "oui" en colonne 3
x = x + 1 'on ajoute 1 pour obtenir 0,1,2 etc
ReDim Preserve T1(3, x) 'on redimmensionne le tableau 3 lignes , x colonnes

T1(0, x) = T(i, 1) 'ici on recupere le MODULE
T1(1, x) = T(i, 2) 'ici la TABLE
T1(2, x) = T(i, 4) 'ici le NOM

End If
Next i
      'ici on va coller le tableau en l'inversant
.Range("F65536").End(xlUp).Offset(1, 0).Resize(UBound(T1, 2), UBound(T1, 1)) = Application.Transpose(T1)
End With
Erase T, T1
End Sub

bonne journée

 

[starz]

Re : Aide macro recherche groupé

merci le fonctionnement est bon !

par contre dans mon vrai fichier et non mon exemple (méa culpa) les données dans les colonnes BLOQUANT et nom/prénom viennent d'une autre feuille sous la forme

=SI(Structure!Q4="";"";Structure!Q4)

du coup quand je valide ma macro mon tableau ne se remplit pas ??

que faire ?

 

[ChTi160]

Re : Aide macro recherche groupé

Re

Je ne comprends pas Lol

Chez moi , même si la valeur est issue d'une formule , ça fonctionne
joins quelque lignes de ton fichier (sans données confidentielles) avec les deux feuilles on verra
Bonne fin de Journée

 

[starz]

Re : Aide macro recherche groupé

voici mon fichier avec un exemple

 

[ChTi160]

Re : Aide macro recherche groupé

re
effectivement
j'avais oublié de mettre un +1 Lol
voila la macro qui fonctionne même si une seule occurrence ="oui"

Sub test()
On Error Resume Next
Dim x As Long, i As Integer, j As Integer, k As Integer, T As Variant, T1() As String, n As String
n = ActiveSheet.Name
Application.ScreenUpdating = False
Columns("e:G").ClearContents
With Worksheets("Feuil1")
.Activate .Range("F5:H" & .Range("F65536").End(xlUp).Row + 1).ClearContents 'on efface la plage
T = .Range("A2:D" & .Range("A65536").End(xlUp).Row) 'on récupére le tableau
x = -1
For i = 1 To UBound(T) 'pour chaque ligne du tableau
If T(i, 3) = "oui" Then 'si "oui" en colonne 3
x = x + 1 'on ajoute 1 pour obtenir 0,1,2 etc

ReDim Preserve T1(3, x) 'on redimmensionne le tableau 3 lignes , x colonnes
T1(0, x) = T(i, 1) 'ici on recupere le MODULE
T1(1, x) = T(i, 2) 'ici la TABLE
T1(2, x) = T(i, 4) 'ici le NOM
End If
Next i 'ici on va coller le tableau en l'inversant
.Range("F65536").End(xlUp).Offset(1, 0).Resize(UBound(T1, 2) [COLOR=Red]+ 1[/COLOR], UBound(T1, 1)) = Application.Transpose(T1)
End With
Erase T, T1
End Sub

excuse
Bonne fin de Journée

 

[smotty]

Re : Aide macro recherche groupé

Bonjour à tous,

Je joins ton fichier avec 2 procédure en Feuille1

une procédure évènementielle qui détecte un changement de valeur dans la colonne qui nous intéresse. et si c'est un oui alors copie les valeur avec la seconde procédure.

Si cette méthode ne te convient pas, tu peux l'adapter.

A+

 

[starz]

Re : Aide macro recherche groupé

merci le ChTi

ça fonctionne 😀

petite chose, afin d'éviter de cliquer sur le bouton pour enclencher la macro, est-ce que cela peux fonctionner tout seul ?



par contre smotty je ne comprend pas il ne se passe rien avec le fichier

 

[smotty]

Re : Aide macro recherche groupé

Pour le fonctionnement automatique, vois le fichier que j'ai joint dans le message précédent.

A+

 

[smotty]

Re : Aide macro recherche groupé

Bonsoir à tous,

Je pense arriver après la bataille mais au cas où, voici le fichier qui fonctionne de façon automatique.
Je n'avais pas vu que les oui et non de la feuille 1 dépendaient de la feuille 2

Le fichier précédent fonctionnait avec des entrées de oui et non manuelles dans la feuille1

Bref celui-ci fonctionne de façon automatique

A+