MACRO recherche automatique

roidurif · 7 Novembre 2008

Bonjour

Je souhaite créer une MACRO dans le fichier "Base_contrat", en cliquant sur un bouton par exemple :

- Demande à ouvrir un 2eme fichier exemple: "fichier à reseigner",
- Une fois le "fichier à renseigner" est ouvert ,
- recherche automatiquement dans la colonne A du 'fichier à renseigner ' , les anciens contrats puis les remplaces par le nouveau du fichier 'Base_contrat'
- renseigne automatiquement dans la colonne C du 'fichier à renseigner ' , la date de fin du nouveau contrat du fichier 'Base_contrat'

Merci de votre aide SVP

Ci joint les fichier .xls

roidurif · 10 Novembre 2008

Re : MACRO recherche automatique

Merci HASCO et GAEL

J'ai fait exactement ce ke tu ma demander de faire HASCO,

Je n'arrive toujours pas à obtenir la recherche er remplace automatiquement

je vous joins ce que j'ai fait

cordialement

Guest · 10 Novembre 2008

Re : MACRO recherche automatique

Re,

Une petite faute de frappe sans doute lorsque j'ai tapé le texte. En relisant et comprenant la macro, tu aurais pu trouvé.

Erreur corrigée en Rouge ici:

Code:

Sub MiseAJourContrats()
    Dim NomFichier As Variant
    Dim WbDest As Workbook
    Dim shDest As Worksheet
    Dim PlageSource As Range, PlageDest As Range, cSource As Range, cDest As Range
    Dim Adr1 As String
    With Sheets("Table")
        Set PlageSource = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    NomFichier = Application.GetOpenFilename(filefilter:="Classeur Microsoft Excel (*.xls)," & ThisWorkbook.Path & "\" & "*.xls", Title:="Choisir le fichier souhaité")
    If NomFichier <> False Then
        'Reférencer le classeur
        Set WbDest = Workbooks.Open(Filename:=NomFichier)
    Else
        Exit Sub
    End If
    'La feuille à renseigner
    On Error Resume Next
    Set shDest = W[SIZE=3][COLOR=red]b[/COLOR][/SIZE]Dest.Sheets("A renseigner")
    On Error GoTo 0
    'Si elle n'existe pas sortir
    If shDest Is Nothing Then Exit Sub
    'Déterminer la plage des numéro de contrat
    With shDest
        Set PlageDest = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    For Each cSource In PlageSource.Cells
        With PlageDest
            Set cDest = .Find(what:=cSource, LookIn:=xlValues, lookat:=xlWhole)
            If Not cDest Is Nothing Then
                Adr1 = cDest.Address
                Do
                    With cDest
                        .Value = cSource.Offset(, 1)  'Nouveau Numéro de contrat
                        With .Offset(, 2)
                            .Value = cSource.Offset(, 2)    'Date Fin
                            .NumberFormat = "dd/mm/yyyy"
                        End With
                    End With
                    Set cDest = .FindNext(cSource)
                    If cDest Is Nothing Then Exit Do
                Loop While cDest.Address <> Adr1
            End If
        End With
    Next cSource
End Sub

J'ai testé le résultat, cela fonctionne.
A+

roidurif · 10 Novembre 2008

Re : MACRO recherche automatique

Vous etes des chefs Hasco et Gael, merci enomement pour votre travail.

Hasco dit moi une derniere chose, si je veux changer de colonne à renseigner pour la date fin du fichier à renseigner. c a d au lieu de de la colonne B mais plustot dans la colonne BC.

Comment dois je proceder pour modifier dans le programme

Merci infiniment

Guest · 10 Novembre 2008

Re : MACRO recherche automatique

Re,

Offset(Ligne,Colonne)

Renvoie la cellule N ligne et N colonne en dessous et à droite si Ligne et Colonne sont positifs ou au dessus et à droite si Ligne et colonne sont négatifs.

L'un des arguments peut être positif et l'autre négatif

Dans ton exemple, jusqu'à lors nous mettions la date dans 2 colonnes à droite de la cellule de destination. Pour la mettre en BC il suffit de changer l'argument offset à 54 colonnes à droite (La colonne BC est la 55ème, La colonne A la 1ère)

Code:

With cDest
   .Value = cSource.Offset(, 1)  'Nouveau Numéro de contrat
   With .Offset(, [SIZE=3][COLOR=red]54[/COLOR][/SIZE])
          .Value = cSource.Offset(, 2)    'Date Fin
           .NumberFormat = "dd/mm/yyyy"
   End With
End With

A+

roidurif · 10 Novembre 2008

Re : MACRO recherche automatique

Merci HASCO pour ton aide,

j'ai essayer d adapter ta macro sur mon vrai fichier cette fois ci.

j ai un bug vers la fin

Merci bcp pour ton aide

Guest · 11 Novembre 2008

Re : MACRO recherche automatique

Bonjour Roi du rif, le forum,

Remplace:

Code:

Set cDest = .FindNext(cSource)

Par:

Code:

 Set cDest = .FindNext(cDest)

A plus

roidurif · 12 Novembre 2008

Re : MACRO recherche automatique

Merci enormemant Hasco pour ton aide,

Dites moi dans le cas où j'ai dans le dichier fichier à renseigner déjà le nouveau contrat de renseigner mais la date de fin n'est pas à jour,

comment dois je procedé pour que cette fois ci, dans la macro, elle voit que le nouveau contrat est bien mis à jour et par contre la date n'est pas MAJ et vienne mettre à jour la date fin.

je te remercie de votre aide.

Ci joint je joint mes fichiers d'exemple avec la macro

Guest · 12 Novembre 2008

Re : MACRO recherche automatique

Bonjour Roidirif, le forum,

Voici ce que tu demandes.

Code:

                    With cDest
                        'Si numéro de contrat non à jour
                        If .Value <> cSource.Offset(, 1) Then
                            .Value = cSource.Offset(, 1)  'Nouveau Numéro de contrat
                        End If
                        With .Offset(, 54)
                            'Si date non à jour
                            If .Value <> cSource.Offset(, 54) Then
                                .Value = cSource.Offset(, 5)    'Date Fin
                                .NumberFormat = "dd/mm/yyyy"
                            End If
                        End With
                    End With

Mais là, laisse moi te dire que j'ai le sentiment que tu ne fais pas beaucoup d'effort pour comprende la macro et intervenir tout seul dessus. La prochaine fois essaie quelque chose et si tu as du mal, reviens avec ce que tu auras tenté.

A+

roidurif · 12 Novembre 2008

Re : MACRO recherche automatique

Merci HASCO, Excuse moi la prochaine fois je t enverrais ce que j'aurais fais de mon coté promis.

j'ai fait ce que tu m'as dit et j'ai une erreure de compilation " End with sans with". Je vois pas

Merci d'avance

Voici ce que tu demandes.

Code:

        Sub MiseAJourContrats()
    Dim NomFichier As Variant
    Dim WbDest As Workbook
    Dim shDest As Worksheet
    Dim PlageSource As Range, PlageDest As Range, cSource As Range, cDest As Range
    Dim Adr1 As String
    With Sheets("Table")
        Set PlageSource = .Range("C10:C" & .Range("C" & .Rows.Count).End(xlUp).Row)
    End With
    NomFichier = Application.GetOpenFilename(filefilter:="Classeur Microsoft Excel (*.xls)," & ThisWorkbook.Path & "\" & "*.xls", Title:="Choisir le fichier souhaité")
    If NomFichier <> False Then
        'Reférencer le classeur
        Set WbDest = Workbooks.Open(Filename:=NomFichier)
    Else
        Exit Sub
    End If
    'La feuille à renseigner
    On Error Resume Next
    Set shDest = WbDest.Sheets("cat")
    On Error GoTo 0
    'Si elle n'existe pas sortir
    If shDest Is Nothing Then Exit Sub
    'Déterminer la plage des numéro de contrat
    With shDest
        Set PlageDest = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    For Each cSource In PlageSource.Cells
        With PlageDest
            Set cDest = .Find(what:=cSource, LookIn:=xlValues, lookat:=xlWhole)
            If Not cDest Is Nothing Then
                Adr1 = cDest.Address
                Do
                    With cDest
                        'Si numéro de contrat non à jour
                        If .Value <> cSource.Offset(, 1) Then
                        .Value = cSource.Offset(, 1)  'Nouveau Numéro de contrat
                        With .Offset(, 54)
                            'Si date non à jour
                            If .Value <> cSource.Offset(, 54) Then
                            .Value = cSource.Offset(, 5)    'Date Fin
                            .NumberFormat = "dd/mm/yyyy"
                            End If
                        End With
                    End With
                    Set cDest = .FindNext(cDest)
                    If cDest Is Nothing Then Exit Do
                Loop While cDest.Address <> Adr1
            End If
        End With
    Next cSource
End Sub

Guest · 12 Novembre 2008

Re : MACRO recherche automatique

Re,

Dans le code que tu m'a donné il manque le End IF de la ligne en rouge ci-dessous. Il était pourtant là dans ce que je t'avais donné dans mon post précédent.

Code:

                    With cDest
                        'Si numéro de contrat non à jour
                        If .Value <> cSource.Offset(, 1) Then
                            .Value = cSource.Offset(, 1)  'Nouveau Numéro de contrat
                        [SIZE=3][COLOR=red]End If 'End if manquant[/COLOR][/SIZE]
                        With .Offset(, 54)
                            'Si date non à jour
                            If .Value <> cSource.Offset(, 54) Then
                                .Value = cSource.Offset(, 5)    'Date Fin
                                .NumberFormat = "dd/mm/yyyy"
                            End If
                        End With
                    End With

Pour repérer plus facilement ce genre de problème, il vaut mieux indenter le code comme ci-dessus.

A+

roidurif · 12 Novembre 2008

Re : MACRO recherche automatique

Merci HASCO, là j’ai plus de message d’erreure tout ce passe bien, mais une fois terminé, les date non pas été mise à jour.

Pour moi la macro est correct, je comprends pas

Guest · 12 Novembre 2008

Re : MACRO recherche automatique

Re,

Non seulement une petite erreur (corrigée en rouge ci-dessous) s'était glissée dans dans les décalage de colonne du fichier source, mais c'est normal qu'une fois que tes numéros de contrats aient été changés par un appel à la macro, ceux-ci ne soient plus retrouvés dans le fichier destination.

Il faut faire attention à la cohérence des données et à ce que tu demandes de faire à la macro.

Pour les dates voici:

Code:

With .Offset(, 54)
      'Si date non à jour
      If .Value <> cSource.Offset(, 5) Then
              .Value = cSource.Offset(, [SIZE=3][COLOR=red]5[/COLOR][/SIZE])    [COLOR=red]'Date Fin est à 5 colonnes du numéro de contrat dans le fichier source 
[/COLOR]              .NumberFormat = "dd/mm/yyyy"
      End If
End With

A+

Gael · 12 Novembre 2008

Re : MACRO recherche automatique

Bonsoir Roidurif, salut hasco,

J'ai testé la macro et trouvé un ou 2 problèmes:

1 - Le premier enregistrement trouvé dans la feuille Destination est $A$3 même si on a également le même code en A2. J'avoue que je ne comprends pourquoi la recherche ne se fait pas depuis A2. Ceci étant, le findnext devrait le trouver en dernier. Sinon, on peut modifier la plage en démarrant en A1:

Code:

Set PlageDest = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)

2 - Pour la date, il faut faire un offset de 5 et non pas de 54 pour Csource:

Code:

'Si date non à jour
                            If .Value <> cSource.Offset(, 5) Then
                                .Value = cSource.Offset(, 5)    'Date Fin
                                .NumberFormat = "dd/mm/yyyy"
                            End If

3 - Enfin, et c'est le plus important, il y a peut être une erreur de logique en ce sens que si le n° de contrat est correct, on ne rentre pas dans la boucle de mise à jour puisque la recherche de l'ancien n° de contrat n'a pas abouti et dans ce cas, la date n'est de toutes façons jamais mise à jour. Mais je ne sais pas si on peut se trouver dans le cas où seule la date doit être changée.

@+

Gael

Désolé pour la collision, Hasco mais on se rejoint quand même.

roidurif · 13 Novembre 2008

Re : MACRO recherche automatique

Bonjour Hasco et Gael,

Si je comprends bien, dans un premier temps (Mise à jour contrat)
-Recherche ancien contrat du fichier "base_contrat.xls" et remplace par nouveau contrat "fichier à renseigner.xls"

Puis dans un second temps (Mise à jour date)
-Recherche Mise à jour nouveau contrat faite et Mise à jour date.

Merci

A+

Guest · 13 Novembre 2008

Re : MACRO recherche automatique

Bonjour roi du rif,

Exemple
A un certain moment tu as

Dans base_contrat.xls

Ancien N° Contrat S30002
Nouveau N° contrat F30002
.....
Date 10/10/2008

Dans fichier_a_renseigner.xls

N° Contrat S30002
.......
Date 08/08/20008

Tu Lances la macros

La Macro va rechercher S30002 dans le fichier à renseigner
S'il est trouvé elle remplace S30002 par F30002 et 08/08/2008 par 10/10/2008.

Si pendant la mise au point de la macro il y a eu un problème par exemple ne num de contrat a été changé mais pas la date. Pour refaire les essais il faut que tu rétablisse l'état précédent du fichier Fichier_a_renseigner.xls.
Si tu le laisse tel quel, la ligne avec l'ancien numéro de contrat ne sera plus retrouvée. Donc la date ne pourra plus être changée.

Est-ce plus clair, pour toi?

Pendant la mise au point de la macro je te suggère de copier les anciens numéro de contrats dans une nouvelle colonne du Fichier à renseigner. Si tu constate une erreur après avoir lancé la macro, tu n'auras plus qu'à refaire un copier/coller des ces anciens numéros à leur position d'origine, avant de modifier et relancer la macro.

Le but étant de changer les numéro de contrat et les dates en même temps.

A+

MACRO recherche automatique

roidurif

XLDnaute Occasionnel

Pièces jointes

roidurif

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

roidurif

XLDnaute Occasionnel

Guest

Guest

roidurif

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

roidurif

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

roidurif

XLDnaute Occasionnel

Guest

Guest

roidurif

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

Gael

XLDnaute Barbatruc

roidurif

XLDnaute Occasionnel

Guest

Guest

Discussions similaires

MACRO recherche automatique

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

XLDnaute Occasionnel

Guest

Guest

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

XLDnaute Occasionnel

Guest

Guest

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

XLDnaute Barbatruc

XLDnaute Occasionnel

Guest

Guest

Discussions similaires

Privacy & Transparency

Privacy & Transparency