Fonction Recherchev , pour plusieurs éléments

Bonjour la communauté,

J'aurais besoin de vos connaissances pour répondre à mon besoin.

Je travail sur un tableau annuel qui centralise les erreurs des employés par :

  • Date
  • Type de métier
  • Type d'erreur
  • Commentaire

Je souhaiterai faire apparaître dans un second tableau sur la même feuille, uniquement les dates en fonction des erreurs mais aussi sur quel métier et quelle erreur.

Je vous joint le fichier où j'ai repris juste un mois avec les explications.

D'avance merci

25demande.xlsx (14.57 Ko)

Bonjour,

Un essai à voir

25blondin02.xlsm (23.86 Ko)

Bonsoir M12,

cela répond parfaitement à mon besoin.

Donc de ce que j'ai pu voir, tout se passe en VBA.

Je vais tenter de le faire sur mon fichier principal.

Si besoin je le ferais de nouveau savoir.

Bonjour,

Alors j'ai essayé en adaptant le code mais rien ni fait (je ni connais rien en VBA)

J'obtiens une erreur de débogage "9".

Le tableau récapitulatif se trouve en AA à AG.

J'ai mis dans le fichier joint, mon tableau principal annuel.

D'avance merci de l'aide apporté.

11demande2.xlsx (60.26 Ko)

Bonjour,

Quand on ne connait rien en VBA, la première chose à faire, c'est de donner un classeur avec une présentation finale.

A tester

Bonjour M12,

Une fois de plus merci.

Ok je le serais pour l'avenir de donner le classeur finale

Est il possible de copier le code pour s'en servir sur d'autres onglets en adaptant le code?

Bonjour,

dans ce cas, remplace la partie de ce code

Set F1 = Sheets(1).Range("A1:A" & DernLigne1)
Set F2 = Sheets(1).Range("AA4:AD" & DernLigne2)

Sheets(1).Range("AA4:AD" & DernLigne2).ClearContents

par celui là

Set F1 = ActiveSheet.Range("A1:A" & DernLigne1)
Set F2 = ActiveSheet.Range("AA4:AD" & DernLigne2)

ActiveSheet.Range("AA4:AD" & DernLigne2).ClearContents

Tu auras juste à copier/coller sur la nouvelle feuille

Merci M12 au TOP !

Tout fonctionne !

Bonjour la communauté,

j'ai rajouté une colonne dans le métier préparateur, j'ai modifié le code comme suit

Option Explicit
Option Compare Text

Sub erreur()
Dim F1 As Range
Dim F2 As Range

Dim I As Integer
Dim j As Integer
Dim k As Integer

Dim DernLigne1 As Long
Dim DernLigne2 As Long
DernLigne1 = Range("A" & Rows.Count).End(xlUp).Row
DernLigne2 = Range("AB" & Rows.Count).End(xlUp).Row + 1
Set F1 = ActiveSheet.Range("A1:A" & DernLigne1)
Set F2 = ActiveSheet.Range("AB4:AE" & DernLigne2)

ActiveSheet.Range("AB4:AE" & DernLigne2).ClearContents
    For j = 1 To F2.Rows.Count
        For k = 2 To 33
            For I = 1 To F1.Rows.Count

                    If F1(I, k).Value = 1 And F1(I, 1).Value <> "TOTAL" Then
                    F2(j, 1).Value = F1(I, 1).Value
                    F2(j, 2).Value = Cells(2, k).Value

                            If Cells(2, k).Value = "PREPARATEUR" And Cells(I, k + 1).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 1).Value
                            F2(j, 4).Value = Cells(I, k + 3).Value
                            End If
                            If Cells(2, k).Value = "PREPARATEUR" And Cells(I, k + 2).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 2).Value
                            F2(j, 4).Value = Cells(I, k + 3).Value
                            If Cells(2, k).Value = "PREPARATEUR" And Cells(I, k + 3).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 3).Value
                            F2(j, 4).Value = Cells(I, k + 3).Value
                            End If
                            If Cells(2, k).Value = "CARISTE" And Cells(I, k + 1).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 1).Value
                            F2(j, 4).Value = Cells(I, k + 4).Value
                            End If
                            If Cells(2, k).Value = "CARISTE" And Cells(I, k + 2).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 2).Value
                            F2(j, 4).Value = Cells(I, k + 4).Value
                            End If
                            If Cells(2, k).Value = "CARISTE" And Cells(I, k + 3).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 3).Value
                            F2(j, 4).Value = Cells(I, k + 4).Value
                            End If
                            If Cells(2, k).Value = "RECEPTION" And Cells(I, k + 1).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 1).Value
                            F2(j, 4).Value = Cells(I, k + 2).Value
                            End If
                            If Cells(2, k).Value = "CONTRÔLE" And Cells(I, k + 1).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 1).Value
                            F2(j, 4).Value = Cells(I, k + 4).Value
                            End If
                            If Cells(2, k).Value = "CONTRÔLE" And Cells(I, k + 2).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 2).Value
                            F2(j, 4).Value = Cells(I, k + 4).Value
                            End If
                            If Cells(2, k).Value = "CONTRÔLE" And Cells(I, k + 3).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 3).Value
                            F2(j, 4).Value = Cells(I, k + 4).Value
                            End If
                            If Cells(2, k).Value = "CHARGEMENT" And Cells(I, k + 1).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 1).Value
                            F2(j, 4).Value = Cells(I, k + 3).Value
                            End If
                            If Cells(2, k).Value = "CHARGEMENT" And Cells(I, k + 2).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 2).Value
                            F2(j, 4).Value = Cells(I, k + 3).Value
                            End If
                       j = j + 1
                End If
            Next I
        Next k
    Next j

End Sub

J'obtiens le message " erreur de compilation : Next sans For " lorsque j'execute la macro.

Bonjour,

tout simplement il manque un END IF

If Cells(2, k).Value = "PREPARATEUR" And Cells(I, k + 2).Value = "x" Then
                            F2(j, 3).Value = Cells(3, k + 2).Value
                            F2(j, 4).Value = Cells(I, k + 3).Value
                            'ICI
                            End If
                            If Cells(2, k).Value = "PREPARATEUR" And Cells(I, k + 3).Value = "x" Then

bonjour

une contribution pour les privés de vba ou refractaires

11blondin02-2.xlsx (13.85 Ko)

cordialement

Exacte, merci M12 j'aurais pu le voir de moi même

Bonjour la communauté,

Est il possible de modifier la macro "erreur" (module3) pour que l'on puisse saisir plusieurs erreurs sur la même date mais surtout sur le même métier et que lorsqu'on synthétise, les 2,3 erreurs ou plus apparaissent sur la récap ?


tulipe_4 a écrit :

bonjour

une contribution pour les privés de vba ou réfractaires

cordialement

Bonjour et merci Tulipe_4 pour ta contribution mais je vais rester avec le VBA

Désolé, je n'avais pas vu ta réponse

Ma demande est elle réalisable par modification ou faut il tout réécrire le code ?

N'ayant pas trouvé de mon côté comment faire, j'abandonne cette option.

Rechercher des sujets similaires à "fonction recherchev elements"