XL 2010 extraction donnees [resolu]

[jeffe]

bonjour le forum,
je voudrais retrouver uniquement des actions à réaliser seulement sur des process séléctionnés.
voir le tableau exemple joint ou j'ai mis le resultat attendu.
merci

 

[job75]

Bonjour jeffe,

Voyez le fichier joint et cette macro dans Feuil2 :

Private Sub Worksheet_Activate()
Dim t, nlig&, j%, proces$, i&, n&, resu()
t = Sheets("Feuil1").[B2:H17] 'matrice, plus rapide, plage à adapter
nlig = UBound(t)
For j = 1 To UBound(t, 2)
    If LCase(t(1, j)) = "oui" Then
        proces = t(3, j)
        For i = 4 To nlig
            If t(i, j) <> "" Then
                n = n + 1
                ReDim Preserve resu(1 To 2, 1 To n)
                resu(1, n) = proces
                resu(2, n) = t(i, 1)
            End If
        Next
    End If
Next
'---transposition---
ReDim t(1 To n, 1 To 2)
For i = 1 To n
    t(i, 1) = resu(1, i)
    t(i, 2) = resu(2, i)
Next
'---restitution---
With [A2] 'cellule à adapter
    If n Then .Resize(n, 2) = t
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ sous le tableau
End With
Columns(2).AutoFit 'ajustement largeur
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Elle se déclenche quand on active la feuille.

Elle est très rapide car elle utilise des tableaux VBA.

A+

 

[BOISGONTIER]

Bonsoir,

Sub essai()
  Set d = CreateObject("scripting.dictionary")
  TblImpact = [B2].CurrentRegion.Value: TblBD = [B4].CurrentRegion.Value
  For k = 2 To UBound(TblImpact, 2)
    If TblImpact(1, k) = "oui" Then
      For i = 2 To UBound(TblBD)
        If TblBD(i, k) = "x" Then d(TblBD(1, k) & "|" & TblBD(i, 1)) = ""
      Next i
    End If
  Next k
  Set f = Sheets("feuil2")
  f.[A2].Resize(d.Count) = Application.Transpose(d.keys)
  Application.DisplayAlerts = False
  f.[A2].Resize(d.Count).TextToColumns Other:=True, OtherChar:="|"
End Sub

Boisgontier

 

[job75]

Bonjour jeffe, JB, le forum,

Il est toujours intéressant de comparer les solutions, voyez le fichier joint.

Bonne journée.

 

[jeffe]

bonjour, Boisgontier, job75, le forum,
merci pour vos propositions, je dois m'absenter 4 j, je testerai vos solutions à mon retour, ce qui me permettra de comparer et voir pour la suite de mon projet. je vous retien informé, merci.
jf

 

[zebanx]

Bonjour à Jeffe, Job75, JB, le forum

Une autre proposition en partant d'un code de KLIN89 que je salue et qui se fait trop rare sur le forum 😉.
Merci à Job75 pour avoir compilé les solutions auparavant.

Bonne journée.
zebanx

 

[job75]

Bonjour zebanx,

Ce code ne va pas du tout dans ta macro :

ReDim b(1 To UBound(a, 1), 1 To 2)

car il est évident que b (tableau du résultat) peut comporter beaucoup plus de lignes que a (tableau source).

A+

 

[zebanx]

Bonjour Job75

Merci pour la remarque.
C'est exact et c'est moi qui avait modifié le code de klin89 avec une erreur au départ #1004 mais qui n'avait pas attrait à cette partie donc il faut corriger ce point dans le code, tout à fait ok.

Je reste cependant limité sur une restitution au-delà de 65536 lignes (excel 2003) si par exemple la plupart des cellules étaient avec un "x".
Quelle méthode utiliserais-tu STP pour faire un renvoi automatique aux colonnes suivantes (restituer tableau "b" si n > 65536) ?

T'en remerciant par avance, bonne journée
zebanx

 

[job75]

Re,

En dimensionnant le tableau resu au début avec CountIf (NB.SI) c'est (un peu) plus rapide :

Private Sub Worksheet_Activate()
Dim t, nlig&, j%, proces$, i&, n&, resu()
With Sheets("Feuil1").[B2:H17]
    t = .Value 'matrice, plus rapide, plage à adapter
    ReDim resu(1 To Application.CountIf(.Cells, "x"), 1 To 2)
End With
nlig = UBound(t)
For j = 1 To UBound(t, 2)
    If LCase(t(1, j)) = "oui" Then
        proces = t(3, j)
        For i = 4 To nlig
            If t(i, j) <> "" Then
                n = n + 1
                resu(n, 1) = proces
                resu(n, 2) = t(i, 1)
            End If
        Next
    End If
Next
'---restitution---
With [A2] 'cellule à adapter
    If n Then .Resize(n, 2) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ sous le tableau
End With
Columns(2).AutoFit 'ajustement largeur
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Fichiers (2) joints.

A+

 

[jeffe]

bonjour, je viens de regarder vos solutions qui fonctionnent tres bien, je vous en remercie.
je suis parti sur la solution de job75, mais mon ficjier source etant un peut différent, je suis paumé;(
j'essaie de commenter les lignes mais ne comprend pas tout.
de plus est il possible lors de la restitution d'inscrire le responsable?
merci

 

[job75]

Re,

de plus est il possible lors de la restitution d'inscrire le responsable?
merci

Il suffit de récupérer la colonne W et d'ajouter une 3ème colonne aux résultats.

Le dernier fichier en retour.

A+

 

[jeffe]

Bonjour le forum, job75,
désolé de se retour tardif,
j'essaie de commenter pour comprendre mieux ce que tu as re&lisé, ça avance.
une autre question, est il possible de reporter aussi les informations contenues en B2 et en B3?
merci

 

[job75]

Bonjour jeffe,

une autre question, est il possible de reporter aussi les informations contenues en B2 et en B3?

Le fichier en retour, il suffit de reporter ces informations par des formules de liaison.

A+

 

[jeffe]

Hello, merci, mince je me suis mal exprimé.
C'est un fichier qui va permettre à pluisieurs personnes de renseigner la feuille "initial" plusieurs fois dans lannée.
donc a chaque fois, je dois recuperer la date et le nom en B2 et B3 qui seront renseignés par la personne qui va remplir, puis "GO" et les données s'empileront au fur et a mesure.

 

[job75]

Re,

les données s'empileront au fur et a mesure.

Ce n'est guère cohérent et de toute façon ce n'est plus le même problème.

A+