Recherchev sur plusieurs lignes

Le 14/01/2010 à 13:59

Bonjour

je voudrais retrouver différents éléments dans une liste selon un interlocuteur. Seulement un même interlocuteur peut avoir plusieurs lignes dans la matrice.

Je vous joins le fichier pour exemple.

merci d'avance pour votre aide

309courrier.zip (12.71 Ko)
Le 14/01/2010 à 15:13

Bonjour

Avec INDEX-EQUIV et DECALER

Cordialement

849courrier.zip (13.51 Ko)
29pour-mferrand.rar (223.12 Ko)
Le 14/01/2010 à 16:23

Bonjour à tous,

Avec filtre élaboré

code à placer dans la feuille 'TrameBilan"

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("b2")) Is Nothing Then
''Macros par Claude Dubois pour "delphine7345" Excel-Pratique le 14/01/2010
    With Sheets("Audit")
        Application.ScreenUpdating = False
        .Range("k2").Formula = "=$a2=TrameBilan!$b$2"
        .Range("a1:c" & .[a65000].End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
        "k1:k2"), CopyToRange:=Range("TrameBilan!a6:b6"), Unique:=False
        .Range("k2").ClearContents
    End With
End If
End Sub

Salut Amadéus

Amicalement

Claude

264delphine.zip (22.48 Ko)
Le 29/09/2012 à 22:23

Salut Claude

Je voudrais m’inspirer sur ton VBA mais je n’ai visiblement pas les compétences requises. Peux-tu stp m’aider ?

J’aimerais copier les données sur la feuille « A01B02 » les données de la feuille « Base » selon le choix de la liste déroulante suivi d’une synthèse.

Merci d’avance pour ton aide.

Bonne soirée

Marcello

79test1.xlsx (52.66 Ko)
Le 30/09/2012 à 09:37

Bonjour Celinhos,

Peux-tu me dire ou se situe "Quantité commandée" dans la feuille "Base" de ton fichier?

J'ai peut-être une solution par TCD.

Cdlt.

Le 30/09/2012 à 13:35

Salut Jean-Eric

Désolé, petit oubli...…

Dans la colonne AB

Merci

Marcello

58test1.xlsx (51.79 Ko)
Le 30/09/2012 à 17:39

Re,

Un petit aperçu de ce que je peux faire en TCD.

C'est une première approche en sachant qu'il faudra passer par VBA pour construire le tableau.

Qu'en penses-tu?

Cdlt.

120test2.xlsx (67.52 Ko)
Le 30/09/2012 à 18:00

Salut Jean-Enric

C'est parfait!!!!

Il reste seulement afficher le champs "Ref_doc_no" aussi sur le résultat.

Je hate pour la suite...

Merci beaucoup

Marcello

Le 30/09/2012 à 18:10

RE,

Comme ceci

Cdlt.

196test2.xlsx (67.64 Ko)
Le 30/09/2012 à 18:17

Tout à fait!

Je viens aussi de mettre la Ref_doc_no dans les Etiquettes de lignes pour arriver à ton résultat.

Je pense que le TDC est la meilleure solution.

T'es très fort!

Merci encore et bonne soirée

Marcello

Le 30/09/2012 à 18:21

Re,

Tu vas trop vite...

Il faut passer par VBA, car j'ai renommé manuellement des champs de colonne dans le TCD, et des formats de cellules.

Si le résultat du précédent post te satisfait, je t'automatise le tout. Avec pour toi la possibilité de modifier ces champs de colonnes.

Cdlt.

Le 30/09/2012 à 20:04

salut,

D'accord, je suis très satisfait.

Tu peux y aller...

Encore merci

Marcello

Le 30/09/2012 à 23:45

Re,

Ci-joint fichier.

Pour démarrer le code CTRL + a

Il me reste un souci à régler quand les quantités livrées sont égales aux quantités commandées (voir ligne 55 du TCD).

Tu peux peut-être regarder de ton côté

Cdlt.

Option Explicit
Public Sub PivotTableCreate()

Dim sh As Worksheet
Dim Plage As Range, PTCache As PivotCache, PT As PivotTable
Dim p As PivotField

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set sh = Worksheets("Base de données")

    On Error Resume Next
        ActiveWorkbook.Worksheets("TCD").Delete
    On Error GoTo 0

        With sh
            Set Plage = .Range("A1").CurrentRegion
            'Plage.Select
            Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
                SourceData:=Plage)
            Worksheets.Add after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = "TCD"
            Set PT = PTCache.CreatePivotTable(TableDestination:=Worksheets("TCD").Range("A1"), _
                TableName:="TCD_1")

            With PT
                .PivotFields("Item").Orientation = xlPageField
                .PivotFields("Ref_doc_no").Orientation = xlRowField
                .PivotFields("Issue Date").Orientation = xlRowField

                    With .PivotFields("Livraison")
                        .Orientation = xlColumnField
                        .Position = 1
                    End With

                    With .PivotFields("Quantité Commande")
                        .Orientation = xlDataField
                        .Position = 1
                        .Caption = "Qté commandée"
                    End With

                    With .PivotFields("Issue Qty")
                        .Orientation = xlDataField
                        .Position = 2
                        .Caption = "Qté livrée"
                    End With

                    With .DataPivotField
                        .Orientation = xlColumnField
                        .Position = 2
                    End With

                'Ajout champ calculé Qté livrée / Quantité commande
                .CalculatedFields.Add "%", _
                    "=IF('Quantité Commande' =0,0,'Issue Qty' /'Quantité Commande' )", True
                    With .PivotFields("%")
                        .Orientation = xlDataField
                        .Caption = "% prog"
                        .NumberFormat = "[Blue]0.00%;[Red]-0.00%;;"
                    End With

                'Ajout champ calculé Temps de passage
                .CalculatedFields.Add "Tps de passage", _
                    "=IF('Quantité Commande'='Issue Qty',0,IF('%' >89%,'Livraison' -'Issue Date',0))", True
                    With .PivotFields("Tps de passage")
                        .Orientation = xlDataField
                        .Caption = "Tps de passage "
                        .NumberFormat = "0""j"";;""en progrès"""
                    End With

                'Suppression sous-totaux lignes
                For Each p In PT.PivotFields
                    If p.Orientation = 1 Then p.Subtotals = Array(False, False, False, False, _
                        False, False, False, False, False, False, False, False)
                Next p

                'Affichage (true) ou non (false) des totaux lignes & colonnes
                .ColumnGrand = False
                .RowGrand = False
                'Retire l'affichage des champs du tableau croisé dynamique
                ActiveWorkbook.ShowPivotTableFieldList = False

                Columns("A:J").Select
                Columns("A:J").EntireColumn.AutoFit
                Range("B1").Select

            End With

        End With

    Set Plage = Nothing: Set PTCache = Nothing: Set PT = Nothing

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub
37celinhos-v1.xlsm (61.76 Ko)
Le 01/10/2012 à 10:47

Le problème c'est que les totaux ne sont pas justes car j'ai parlé à la logistique et ils sont obligés de entrer quelques données à la main (conf. Fichier attaché). Ne pense tu pas que il serait plus facile de travailler en recherchev par VBA?

Merci quand même pour ton excellent job (ce fichier là je le garde pour plus tard!)

Marcello

34celinhos-2.xlsx (53.13 Ko)
Le 23/01/2014 à 16:27

Bonjour tout le monde,

Je réactive la discussion car je rencontre un nouveau problème. J'ai un fichier dans lequel j'ai utilisé et adapté le code de "dubois". Ce code fait référence à la cellule R10 mais je souhaiterai que rien ne se produise quand cette cellule est vide ou est égale à zéro. Je touche a peine au VBA et ne trouve pas de solution, quelqu'un pourrait-il m'aider??

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("R10")) Is Nothing Then
    With Sheets("ENCODAGE COMMANDES")
          Application.ScreenUpdating = False
        .Range("k2").Formula = "=$F12=FAX!$R$10"
        .Range("F11:L" & .[F10100].End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
        "k1:k2"), CopyToRange:=Range("FAX!F24:K24"), Unique:=False
        .Range("k2").ClearContents
    End With
End If
End Sub

Merci d'avance

Le 24/01/2014 à 10:56

Bonjour,

A tester.

Cdlt

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("R10")) Is Nothing Then
        If IsEmpty([R10]) Or [R10] = 0 Then Exit Sub
        With Sheets("ENCODAGE COMMANDES")
            Application.ScreenUpdating = False
            .Range("k2").Formula = "=$F12=FAX!$R$10"
            .Range("F11:L" & .[F10100].End(xlUp).Row).AdvancedFilter _
                    Action:=xlFilterCopy, CriteriaRange:=.Range("k1:k2"), _
                    CopyToRange:=Range("FAX!F24:K24"), Unique:=False
            .Range("k2").ClearContents
        End With
    End If
End Sub
Le 07/02/2014 à 17:38
Jean-Eric a écrit :

Bonjour,

A tester.

Cdlt

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("R10")) Is Nothing Then
        If IsEmpty([R10]) Or [R10] = 0 Then Exit Sub
        With Sheets("ENCODAGE COMMANDES")
            Application.ScreenUpdating = False
            .Range("k2").Formula = "=$F12=FAX!$R$10"
            .Range("F11:L" & .[F10100].End(xlUp).Row).AdvancedFilter _
                    Action:=xlFilterCopy, CriteriaRange:=.Range("k1:k2"), _
                    CopyToRange:=Range("FAX!F24:K24"), Unique:=False
            .Range("k2").ClearContents
        End With
    End If
End Sub

Impec !!! Ça marche et du coup mon problème est réglé. Un grand merci à toi Jean-Eric.

Le 13/02/2014 à 21:00

Bonjour, c'est a nouveau moi !!!

Je reviens vers vous avec le même code que précédemment car j'ai un nouveau problème.

Avec ce code, est-ce possible de protéger ma feuille ? Avec un MDP si possible ? et comment l'intégrer au code ? car si je protège ma feuille manuellement et que j'utilise ma fonction, elle bug.....

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("P10")) Is Nothing Then
        If IsEmpty([P10]) Or [P10] = 0 Then Exit Sub
        With Sheets("ENCODAGE COMMANDES")
            Application.ScreenUpdating = False
            .Range("k2").Formula = "=$A13=FAX!$P$10"
            .Range("A12:L" & .[A10100].End(xlUp).Row).AdvancedFilter _
                    Action:=xlFilterCopy, CriteriaRange:=.Range("k1:k2"), _
                    CopyToRange:=Range("FAX!B24:M24"), Unique:=False
            .Range("k2").ClearContents

         End With
     End If
 End Sub

Merci d'avance pour ceux qui prendront le temps

Niclus

Rechercher des sujets similaires à "recherchev lignes"