fonction de recherche

[thyuki]

Bonjour a tous,

je dois faire une fonction de recherche et d'ajout. je m'explique
j'ai un classeur avec deux feuilles, dans la feuille A, je prend chaque élément de la colonne A et je dois les rechercher dans ma feuille B, il peut y avoir plusieurs fois le même élément dans la feuille B.
Après chaque "trouvaille" dans la feuille B, on copie le reste de la ligne de la feuille A à partir de la cellule (CV) dans la ligne de l'élément trouver
ensuite je voudrais mettre les éléments copier dans la feuille B en rouge et gras

j'ai trouvé la fonction Find() grâce à l'aide VB, malheureusement j'ai une erreur dessus:

référence incorrecte ou non qualifiée

est-ce que quelqu'un peut m'aider à résoudre l'erreur

Sub Test_traitement()
    Dim resultat As String
    Dim Fichier_Cto As String, Fichier_A As String, fichier_Bilan As String
    Dim Cto As String, A As String, Bilan As String
    Dim objFSO As Object
    Dim Rec As Range, Final As Range
    Dim Valeur As Double, i As Double
    Dim firstAddress As String
        
               
    'demande à l'utilisateur de saisir le chemin d'accès pour trouver les fichiers a traiter
    resultat = InputBox("Entrer le chemin d'accès au dossier contenant les fichiers que vous voulez ouvrir", "Titre", "chemin d'accès")
    
    Cto = Dir(resultat + "\CTO*.xls")
    A = Dir(resultat + "\A30*.xls")
    Fichier_Cto = resultat + "\" + Cto                                  'donne le chemin d'accès au fichier cto*.xls
    Fichier_A = resultat + "\" + A                              'donne le chemin d'accès au fichier A30*.xls
      
    Set objFSO = CreateObject("Scripting.FileSystemObject")             'test de l'existance du fichier
    If objFSO.FileExists(resultat + "\bilan a.xls") Then            'ouverture du classeur bilan a
        Workbooks.Open Filename:=(resultat + "\bilan a.xls")
    Else
        Workbooks.Add.SaveAs (resultat + "\bilan a.xls")            'création et sauvegarde d'un classeur bilan a
        Worksheets.Add.Name = "Cto"
    End If
  
    Bilan = Dir(resultat + "\Bilan*.xls")
    fichier_Bilan = resultat + "\" + Bilan
    
    Workbooks.Open Filename:=Fichier_Cto                                'ouvre le premier classeur
    Workbooks.Open Filename:=Fichier_A                           'ouvre le deuxième classeur

    Workbooks(Cto).Worksheets("Check A30").Copy before:=Workbooks("bilan a.xls").Worksheets("Cto")
    'copie la feuille a30 du classeur CTO*.xls
    Workbooks(A).Worksheets(1).Copy After:=Workbooks("bilan a.xls").Worksheets("Cto")
    'copie de la feuille du tableur A30*.xls dans le bilan
    
    Workbooks(Bilan).Worksheets("check A30").Activate                   'on se met sur la feuille check A30
    
    'With Worksheets("check A30").Range("A19:A200")
    Rec = "A19"                                                                 'on commence la recherche a la ligne 19
    While Range(Rec).Value <> ""                                                'tant que la cellule n'est pas vide on continu
        Valeur = Range(Rec).Value                                               'on garde la valeur a rechercher
        Workbooks(Bilan).Worksheets("Sheet1").Activate                          'on se place dans l'autre feuille
      Set Final = .Find(Valeur)                                                'on cherche la valeur dans l'autre classeur
        If Not Valeur Is Nothing Then                                           'si la valeur est trouver alors
            firstAddress = c.Address                                            'on garde le numero de la case de laquelle on part pour le test final
            Do
                Range(Final).Row(CV) = Range(Rec).Row(B)                        'on copie le contenu de la ligne de rec a partir de la colone B dans l'autre page a la ligne trouvée à partir de la colone CV
                Set Final = .FindNext(Final)                                     'on passe à l'élément suivant
            Loop While Not Final Is Nothing Or Valeur.Address <> firstAddress   'test de sortie de la boucle si final est vide ou si on est retourné sur la première cellule traitée
        End If
    Next Rec
    Workbooks(Bilan).Save                                                       'on sauvegarde le fichier traité
    
End Sub

L'erreur est a la ligne Set Final = .Find(Valeur)
merci

 

[Bebere]

Re : fonction de recherche

bonjour Thyuki
à tester,si ne va pas un bout de fichier,svp

    'With Worksheets("check A30").Range("A19:A200")
    For i = 19 To 200
        Valeur = Range("A" & i).Value
   With Workbooks(Bilan).Worksheets("Sheet1")
      Set c = .Cells.Find(Valeur) 'mis cells ne sachant pas quelle colonne ex:si A tu peux mettre .Columns(1)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
            'tu changes "B" si nécessaire
                Range("B" & c.Row) = Range(Rec).Row(B)
                Set c = .Cells.FindNext(c) 'mis cells ne sachant pas quelle colonne ex:si A tu peux mettre .Columns(1)
            Loop While Not c Is Nothing Or c.Address <> firstAddress
        End If
        End With
    Next i
    
    Workbooks(Bilan).Save                                                       'on sauvegarde le fichier traité

à bientôt

 

[thyuki]

Re : fonction de recherche

merci bebere,

malheureusement l'erreur c'est décalé ^^ elle est sur
Range("B" & c.Row) = Range(Rec).Row(B)

l'erreur est: erreur d'execution '1004'
la méthode 'Range' de l'objet '_global' a échoué.

je te joins les 2 fichiers que j'utilise ainsi que le fichier que je créé.

merci pour ton aide

thyuki

je te remet le code

Sub Test_traitement()
    Dim resultat As String
    Dim Fichier_Cto As String, Fichier_Aipsi As String, fichier_Bilan As String
    Dim Cto As String, Aipsi As String, Bilan As String
    Dim objFSO As Object
    Dim Rec As Range, Final As Range
    Dim Valeur As String
    Dim i As Double
    Dim firstAddress As String
        
               
    'demande à l'utilisateur de saisir le chemin d'accès pour trouver les fichiers a traiter
    resultat = InputBox("Entrer le chemin d'accès au dossier contenant les fichiers que vous voulez ouvrir", "Titre", "chemin d'accès")
    
    Cto = Dir(resultat + "\CTO*.xls")
    Aipsi = Dir(resultat + "\Aipsi30*.xls")
    Fichier_Cto = resultat + "\" + Cto                                  'donne le chemin d'accès au fichier cto*.xls
    Fichier_Aipsi = resultat + "\" + Aipsi                              'donne le chemin d'accès au fichier aipsi30*.xls
      
    Set objFSO = CreateObject("Scripting.FileSystemObject")             'test de l'existance du fichier
    If objFSO.FileExists(resultat + "\bilan aipsi.xls") Then            'ouverture du classeur bilan aipsi
        Workbooks.Open Filename:=(resultat + "\bilan aipsi.xls")
    Else
        Workbooks.Add.SaveAs (resultat + "\bilan aipsi.xls")            'création et sauvegarde d'un classeur bilan aipsi
        Worksheets.Add.Name = "Cto"
    End If
  
    Bilan = Dir(resultat + "\Bilan*.xls")
    fichier_Bilan = resultat + "\" + Bilan
    
    Workbooks.Open Filename:=Fichier_Cto                                'ouvre le premier classeur
    Workbooks.Open Filename:=Fichier_Aipsi                              'ouvre le deuxième classeur

    Workbooks(Cto).Worksheets("Check AIPSI30").Copy before:=Workbooks("bilan aipsi.xls").Worksheets("Cto")
    'copie la feuille aipsi30 du classeur CTO*.xls
    Workbooks(Aipsi).Worksheets(1).Copy After:=Workbooks("bilan aipsi.xls").Worksheets("Cto")
    'copie de la feuille du tableur Aipsi3à*.xls dans le bilan
    
    Workbooks(Bilan).Worksheets("check AIPSI30").Activate                   'on se met sur la feuille check AIPSI30
    
    For i = 19 To 200
        Valeur = Range("A" & i).Value
        With Workbooks(Bilan).Worksheets("Sheet1")
            Set c = .Columns(1).Find(Valeur) 'mis cells ne sachant pas quelle colonne ex:si A tu peux mettre .Columns(1)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                'tu changes "B" si nécessaire
                    Range("B" & c.Row) = Range(Rec).Row
                    Set c = .Columns(1).FindNext(c)
                    Loop While Not c Is Nothing Or c.Address <> firstAddress
            End If
        End With
    Next i
   
    Workbooks(Bilan).Save
    
End Sub

 

[Bebere]

Re : fonction de recherche

bonjour Thiuky
explique étape par étape ce que le code doit faire
une feuille est nommée Cto et reste vide
as-tu besoin de garder tous ces classeurs ouvert
dans le fichier bilan_aspi.sheet1 je ne vois que exploit avec exp
feuille A et B sont bien bilan_aspi.Check AIPSI30(colonne A avec exp) et bilan_aspi.sheet1

 

[thyuki]

Re : fonction de recherche

alors non la feuille cto ne sert a rien c'est moi qui l'ai créer parce que je ne savais pas faire sans.
Pour les autres classeurs, ils ne sont pas obligatoirement ouvrables mais étant débutant c'était plus simple pour moi

j'ai un classeur avec deux feuilles, dans la feuille A (CTO EXP.check aipsi30 ...), je prend chaque élément de la colonne B et je dois les rechercher dans ma feuille B(aipsi30.sheet1 ...), il peut y avoir plusieurs fois le même élément dans la feuille B.
Après chaque "trouvaille" dans la feuille B(aipsi30.sheet1 ...), on copie le reste de la ligne de la feuille A (CTO EXP.check aipsi30 ...) à partir de la cellule (CV) dans la ligne de l'élément trouver
ensuite je voudrais mettre les éléments copier dans la feuille B(aipsi30.sheet1 ...) en rouge et gras


voila j'espère que c'est plus clair pour vous

merci de votre aide

 

[Bebere]

Re : fonction de recherche

Thyuki
pas moyen d'avoir un résultat,bécause cellules fusionnées
construit ta feuille autrement
à bientôt

 

[thyuki]

Re : fonction de recherche

petites questions : en quoi la fusion de cellules empêche le fonctionnement des la macro?

et merci encore pour ton aide

 

[Bebere]

Re : fonction de recherche

bonjour Thiuky
excel est un tableur et pas un traitement de texte
en plus difficile à gérer en vba
enlever les fusions où il fallait et fait la recherche avec une boucle
le code en module2
tu choisis le dossier où sont les fichiers
il y a moyen d'arranger le code pour boucler sur plusieurs fichiers cto
à bientôt

 

[thyuki]

Re : fonction de recherche

énorme merci beaucoup !!!
je vais décortiquer le code pour comprendre en détail le fonctionnement donc il n'est pas dit que je n'ai pas quelques questions à te poser.

merci encore