Macro Recherche/Condition

S

skun

XLDnaute Occasionnel
Bonjour le forum,

Je travail encore sur une base de donnée qui me pose des problèmes.

Le but de la macro que je souhaiterai créer est de:
  • Chercher
  • Recopier
  • et Créer des lignes si besoin est.

J'ai tout expliqué sur mon fichier joint, mais je vais faire un petit résumé ici.

Contexte: Une base de donnée regroupant les informations: tournée, camion, chauffeur, durée tournée, pour chaque jour.
Mon objectif est de facilité la lecture de cette base de donnée en faisant un petit récapitulatif par date:

* soit pour un chauffeur choisie
* soit pour un camion choisie
* soit pour une tournée choisie


Il y a 2 feuilles:

-BD tournée: base de donnée organisé : par dates en lignes (1 lignes = 1 date)

-Recap: Feuille récapitulative: A1= chauffeur ou camion ou tournée.
en fonction de ce choix, B1 = soit la liste des chauffeurs, soit la liste des camions, soit la liste des tournées.

selon que l'on recherche un camion ou un chauffeur, la recherche devra etre différente car la base de donnée est particulière.


2eme étape: L'écriture, elle sera la meme pour tout type de recherche.
elle consiste à réecrire les élements trouvés lors de la précédente recherche.


3eme étape: création de ligne expliqué dans l'exemple joint.



Voilà c'est un peu vague , mais c'est pour donner une idée, normalement c'est déjà plus clair sur le doc joint.

ps: j'ai laissé une macro qui ne correspond pas à ce cas, mais qui utilise la fonction recherche par date donc peut etre source d'inspiration (merci jp14) .. je n'arrive biensur pas à m'en inspirer tout seul :(


Je vous remercie d'avance pour vos lumières


salutations


skun
 

Pièces jointes

  • Nouveau Feuille de calcul Microsoft Excel.zip
    13.6 KB · Affichages: 35
  • Nouveau Feuille de calcul Microsoft Excel.zip
    13.6 KB · Affichages: 34
  • Nouveau Feuille de calcul Microsoft Excel.zip
    13.6 KB · Affichages: 36
Dernière édition:
Trier par date Trier par votes
skoobi

skoobi

XLDnaute Barbatruc
Re : Macro Recherche/Condition

Bonjour,
Ci-joint une proposition.
le code s'exécute après sélection en B1.
Attention tout de même: si jamais des lignes ont été insérées, il faudra réactualiser le tableau sans les dates "doulons" si jamais tu veux réexécuter la macro.
 

Pièces jointes

  • test1.zip
    18.6 KB · Affichages: 66
  • test1.zip
    18.6 KB · Affichages: 66
  • test1.zip
    18.6 KB · Affichages: 65
Vote positif 0 Vote négatif
S

skun

XLDnaute Occasionnel
Re : Macro Recherche/Condition

Bonjour skoobi,
je te remercie, c'est exactement ce que je cherchais, c'est impressionnant

Par contre j'aimerai rajouter:

si A1 = tournée ,
  • alors la macro va chercher dans "BD Tournée" sur la première ligne la cellule étant égale à B1 (le numéro de tournée)
  • puis, elle va chercher la ligne correpondant a la date et correspondant à la collone, on appelera ce point "i"

    elle copie les informations :
    * "i-1" ===> chauffeur
    * "i" ===> camion
    * "i+1" ===> Durée tournée

    qu'elle devra réecrire dans le meme ordre
    * d+1 = chauffeur
    * d+2 = camion
    * d+3 = Durée tournée

Avec la meme logique que si il y a des doublons la macro crée une ligne.

donc voilà si tu peux m'aider à adapter cette petite condition ca serait super.

Je vous remercie d'avance pour vos lumières

salutations

skun
 
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Macro Recherche/Condition

Bonjour,

chose promise...:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim MaDate As Range, TrouveX As Range, TrouveDate As Range, FirstAddress As String, Datas(1 To 1, 1 To 3)
  Dim i As Long, j As Long, ListeDate(), DerLig As Long
'si cellule B1 modifié
  If Target.Address = "$B$1" Then
'on vide le tableau
    DerLig = [A65536].End(xlUp).Row
    Range("A10:D" & DerLig).ClearContents
'dans la feuille BD tournée
    With Sheets("BD tournée")
'on copie la liste des dates dans RECAP
      .Range("A3", .[A65536].End(xlUp)).Copy [A10]
      Select Case Sheets("RECAP").[A1].Value
'si dans feuille RECAP, A1 = "chauffeur", "camion"
      Case "chauffeur", "camion"
'on récupère la liste des dates dans un tableau VBA étant donné qu'il peut y avoir des dates
'insérées
        ListeDate = Range("A10", [A65536].End(xlUp))
'on parcours cette liste
        For j = LBound(ListeDate, 1) To UBound(ListeDate, 1)
'on cherche la dateX dans la colonne A feuille RECAP
          Set MaDate = Columns("A").Find(ListeDate(j, 1), LookIn:=xlValues, lookat:=xlWhole)
          i = 0
'on cherche la dateX dans la colonne A feuille BD tournée
          Set TrouveDate = .Columns("A").Find(MaDate.Value, LookIn:=xlValues, lookat:=xlWhole)
          If Not TrouveDate Is Nothing Then
'on cherche "chauffeur" ou "camion" sur la ligne de la dateX
            Set TrouveX = .Rows(TrouveDate.Row).Find(Sheets("RECAP").[B1].Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not TrouveX Is Nothing Then
              FirstAddress = TrouveX.Address
              Do
'ici on alimente un tableau VBA pour la copie
                i = i + 1
                Datas(1, 1) = IIf(Sheets("RECAP").[A1].Value = "chauffeur", .Cells(1, TrouveX.Column + 1).Value, .Cells(1, TrouveX.Column).Value)
                Datas(1, 2) = IIf(Sheets("RECAP").[A1].Value = "chauffeur", TrouveX.Offset(0, 1).Value, TrouveX.Offset(0, -1).Value)
                Datas(1, 3) = IIf(Sheets("RECAP").[A1].Value = "chauffeur", TrouveX.Offset(0, 2).Value, TrouveX.Offset(0, 1).Value)
'ici on complète le tableau RECAP en ajoutant une ligne si nécessaire
                If i = 1 Then
                  Range(MaDate.Offset(0, 1), MaDate.Offset(0, 3)).Value = Datas
                Else:
                  Rows(MaDate.Row + i - 1).Insert Shift:=xlDown
                  Range("A" & MaDate.Row + i - 1).Value = MaDate.Value
                  Range("B" & MaDate.Row + i - 1 & ":D" & MaDate.Row + i - 1).Value = Datas
                End If
                Set TrouveX = .Rows(TrouveDate.Row).FindNext(TrouveX)
              Loop While Not TrouveX Is Nothing And TrouveX.Address <> FirstAddress
            End If
          End If
        Next
'si dans feuille RECAP, A1 = "tournée"
      Case "tournée"
        Set TrouveX = .Rows(1).Find(Sheets("RECAP").[B1].Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not TrouveX Is Nothing Then
          DerLig = .[A65536].End(xlUp).Row
          .Range(.Cells(3, TrouveX.Column - 1), .Cells(DerLig, TrouveX.Column + 1)).Copy
          [B10].PasteSpecial xlPasteValues
          Application.CutCopyMode = False
          [B1].Select
        End If
      End Select
    End With
  End If
End Sub

A noter que dorénavant la liste des dates est directement reprise de la feuille "BD tournée" au démarrage du code.
Bon test et bonne journée.
 
Vote positif 0 Vote négatif
S

skun

XLDnaute Occasionnel
Re : Macro Recherche/Condition

Bonjour skoobi,

je te remercie pour ce code, mais surtout pour les explications fournies avec qui me permettrons je l'espere de l'adapter / le modifier et surtout de progresser.

Juste un point au niveau de la création des dates, j'utiliserai une autre technique que j'ai trouvé hier soir, je vais essayé de faire l'adaptation, je pense pouvoir m'en sortir seul vu tes indications :D au pire, je posterai

merci pour le temps consacré

bonne journée

skun
 
Vote positif 0 Vote négatif
S

skun

XLDnaute Occasionnel
Re : Macro Recherche/Condition

Bonsoir,
En testant encore et encore ce code, je me suis aperçu d'un disfonctionnement:

n'utilisant la meme gestion des dates que celles que tu m'as proposé , je l'ai donc enlevé du code. La longueur de la liste des dates peut etre variable.
Or j'ai l'impression qu'avec le choix si A1= tournée , alors la macro ne se réfère pas aux dates (apartir de B10) pour rechercher mais en fonction des lignes.

Or , avec A1 = chauffeur ou camion, cela marche. Le bug vient juste du dernier bout de code pour les tournées. j'ai joint un exemple ou l'on voit bien ce phénomène: les valeurs sont affichées alors qu'elles ne devraient pas car il n'y pas de dates écrit. Cela prend de l'importance car quelque soit la date choisi ces valeurs s'inscriront à ces endroits, ce qui fausse le résultat.

Si quelqu'un à une idée sur la question ^^

je vous remercie pour vos suggestions.

salutations

skun
 

Pièces jointes

  • test1.zip
    24.4 KB · Affichages: 27
  • test1.zip
    24.4 KB · Affichages: 28
  • test1.zip
    24.4 KB · Affichages: 30
Dernière édition:
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Macro Recherche/Condition

Bonsoir skun,

pour ce qui est de la liste de date, je croyais que tu reprenais la liste complète de BD tournée, d'où l'importance d'être le plus précis possible lors de la demande, mais je ne t'en tiendrais pas rigueur :D;).

Voici le code adapté:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim MaDate As Range, TrouveX As Range, TrouveDate As Range, FirstAddress As String, Datas(1 To 1, 1 To 3)
  Dim i As Long, j As Long, ListeDate(), DerLig As Long, TrouveTourne As Range
'si cellule B1 modifié
  If Target.Address = "$B$1" Then
'on vide le tableau

'dans la feuille BD tournée
    With Sheets("BD tournée")
'on copie la liste des dates dans RECAP
      Select Case Sheets("RECAP").[A1].Value
'si dans feuille RECAP, A1 = "chauffeur", "camion"
      Case "chauffeur", "camion"
'on récupère la liste des dates dans un tableau VBA étant donné qu'il peut y avoir des dates
'insérées
        ListeDate = Range("A10", [A65536].End(xlUp))
'on parcours cette liste
        For j = LBound(ListeDate, 1) To UBound(ListeDate, 1)
'on cherche la dateX dans la colonne A feuille RECAP
          Set MaDate = Columns("A").Find(ListeDate(j, 1), LookIn:=xlValues, lookat:=xlWhole)
          i = 0
'on cherche la dateX dans la colonne A feuille BD tournée
          Set TrouveDate = .Columns("A").Find(MaDate.Value, LookIn:=xlValues, lookat:=xlWhole)
          If Not TrouveDate Is Nothing Then
'on cherche "chauffeur" ou "camion" sur la ligne de la dateX
            Set TrouveX = .Rows(TrouveDate.Row).Find(Sheets("RECAP").[B1].Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not TrouveX Is Nothing Then
              FirstAddress = TrouveX.Address
              Do
'ici on alimente un tableau VBA pour la copie
                i = i + 1
                Datas(1, 1) = IIf(Sheets("RECAP").[A1].Value = "chauffeur", .Cells(1, TrouveX.Column + 1).Value, .Cells(1, TrouveX.Column).Value)
                Datas(1, 2) = IIf(Sheets("RECAP").[A1].Value = "chauffeur", TrouveX.Offset(0, 1).Value, TrouveX.Offset(0, -1).Value)
                Datas(1, 3) = IIf(Sheets("RECAP").[A1].Value = "chauffeur", TrouveX.Offset(0, 2).Value, TrouveX.Offset(0, 1).Value)
'ici on complète le tableau RECAP en ajoutant une ligne si nécessaire
                If i = 1 Then
                  Range(MaDate.Offset(0, 1), MaDate.Offset(0, 3)).Value = Datas
                Else:
                  Rows(MaDate.Row + i - 1).Insert Shift:=xlDown
                  Range("A" & MaDate.Row + i - 1).Value = MaDate.Value
                  Range("B" & MaDate.Row + i - 1 & ":D" & MaDate.Row + i - 1).Value = Datas
                End If
                Set TrouveX = .Rows(TrouveDate.Row).FindNext(TrouveX)
              Loop While Not TrouveX Is Nothing And TrouveX.Address <> FirstAddress
            End If
          End If
        Next
'si dans feuille RECAP, A1 = "tournée"
      Case "tournée"
      'pour chaque date dans RECAP
        For Each MaDate In Range("A10", [A65536].End(xlUp))
      'on cherche cette date dans BD tournée
          Set TrouveDate = .Columns(1).Find(MaDate.Value, LookIn:=xlValues, lookat:=xlWhole)
      'on cherche la tournée dans BD tournée
          Set TrouveTourne = .Rows(1).Find(Sheets("RECAP").[B1].Value, LookIn:=xlValues, lookat:=xlWhole)
          If Not TrouveTourne Is Nothing And Not TrouveDate Is Nothing Then
      'on récupère la ligne et les colonnes nécessaires
            Lig = TrouveDate.Row: ColDeb = TrouveTourne.Column - 1: ColFin = TrouveTourne.Column + 1
      'on colle le résultat dans RECAP
            Range("B" & MaDate.Row & ":D" & MaDate.Row).Value = .Range(.Cells(Lig, ColDeb), .Cells(Lig, ColFin)).Value
          End If
        Next
      End Select
    End With
  End If
End Sub
Bonne soirée.
 
Vote positif 0 Vote négatif
S

skun

XLDnaute Occasionnel
Re : Macro Recherche/Condition

Salut !

Je me permet de remonter ce fils car j'ai un soucil avec la macro.

Si lors de la recherche, la ligne de A10 (la première case du tableau) doit etre remplie (ce qui veut dire que la recherche veut faire correpondre à la 1ere date A10 des valeurs) alors ca n'affiche rien.
Mais ca entreinne aussi la supression de B6 :eek:
et ca fait donc buggué la feuille de calcul.....

Si tu as une idée skoobie? je ne peux malheuresement pas joindre sur le fofo mon cas... :( cependant j'ai utilisé le code que tu m'as fait.

merci d'avance


skun
 
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Macro Recherche/Condition

Bonjour skun,

skun à dit:
Salut !

Je me permet de remonter ce fils car j'ai un soucil avec la macro.

Si lors de la recherche, la ligne de A10 (la première case du tableau) doit etre remplie (ce qui veut dire que la recherche veut faire correpondre à la 1ere date A10 des valeurs) alors ca n'affiche rien.
Mais ca entreinne aussi la supression de B6 :eek:
et ca fait donc buggué la feuille de calcul.....

skun
Cliquez pour agrandir...

Désolé mais j'ai rien compris. Pourrais-tu expliquer plus en détail ou donner un cas précis?

Bonne soirée.
 
Vote positif 0 Vote négatif
S

skun

XLDnaute Occasionnel
Re : Macro Recherche/Condition

Bonjour skoobi,

Enfait, j'ai un peu modifié la macro que tu m'avais fait, j'ai rajouter une petite partie qui permet de créer un nombre de ligne(date) en fonction de la periode choisie.

J'ai fait un document où l'on peut voir le bug.

voilà, là si on appuie sur le bouton de la macro, la recherche se fait, et l'écriture aussi. Pas de problème à signaler, on remarquera juste qu'il n'y a rien écrit sur la première date (01/01/2009) car il n'y a pas de donnée dans la base de donnée corespondant aux critères de recherche.

Donc maintenant, on va inscrire 02/01/2009 dans la cellule A6. On active le bouton. et voilà.... la recherche se fait, l'écriture se fait pour toutes les dates sauf la 1ere: 02/01/2009 (alors qu'il y avait des donnée corespondant à nos critères dans la base de donnée) et on peut aussi remarqué que B6 s'est buggué au passage. si on rappuie une 2eme fois sur le bouton c'est la cata :(

Je sais pas du tout d'ou celà provient...
J'ai remarqué que ca ne le faisait pas avec A1= "tournée"
par contre avec A1= camion ou chauffeur ca bug :(

aurais tu une idée d'où celà peut provenir ?


merci

skun
 

Pièces jointes

  • testbug.xls
    42 KB · Affichages: 48
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Macro Recherche/Condition

Bonjour skun,

le problème viens de là:

Code: 
          Set MaDate = Columns("A").Find(ListeDate(j, 1), LookIn:=xlValues, LookAt:=xlWhole)
Pourquoi?
Ici la date figurant dans ListeDate est cherchée dans la colonne A.
Comme tu as précisé une plage de date en A6:B6 et bien la première date trouvé sera A6 et non A10...
Donc si il y a une donnée à écrire c'est sur cette ligne 6 que cela va se faire et pas dans le tableau, tu me suis?
Il faut redéfinir la zone dans laquelle la recherche doit se faire (que tu as identifié par la variable "R") et tout rentrera dans l'ordre:
Code: 
          Set MaDate = [COLOR=Blue][B]R[/B][/COLOR].Find(ListeDate(j, 1), LookIn:=xlValues, LookAt:=xlWhole)
;)

Bon test.
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
Microsoft 365 Problèmes multipages dans usf
2
Réponses
16
Affichages
663
ChTi160
ChTi160
P
  • Question
Microsoft 365 Rechercher un fichier dans dossier
Réponses
14
Affichages
708
pelerin65
P
H
  • Question
XL 2016 fonction FILTRE sur Excel 2016
Réponses
9
Affichages
432
Hynnuh
H
L
  • Question
XL 2016 Liste déroulante d'image
2
Réponses
17
Affichages
681
littlebird2
L
3
  • Question
XL 2013 Recherche a plusieurs critéres
Réponses
2
Affichages
239
Gégé-45550
Gégé-45550
P
  • Question
Microsoft 365 supprimer bouton lors de l'enregistrement
2
Réponses
28
Affichages
959
Staple1600
Staple1600
C
  • Résolu(e)
Power Query Regroupement suivant un code
Réponses
2
Affichages
203
combory
C
G
  • Question
XL 2021 Demande d'aide formulaire
Réponses
2
Affichages
255
sousou
sousou
V
  • Question
XL 2016 Filtre sur une liste de valeur
Réponses
4
Affichages
406
VincentINV
V
J
  • Question
XL 2021 Afficher date dernière actualisation
Réponses
9
Affichages
339
julienha
J

Membres actuellement en ligne

19 membres et 322 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 231
Messages
2 086 447
Membres
103 213
dernier inscrit
Poupoule