Rechercher une valeur sur plusieurs lignes

Résolu

siamens_duj Messages postés 192 Date d'inscription Statut Membre Dernière intervention -
siamens_duj Messages postés 192 Date d'inscription Statut Membre Dernière intervention - 7 juin 2016 à 09:34

Bonjour,

j'ai fais un code qui me permet de rechercher une valeur entré dans une inputbox.
Si ce qui est entré dans l'inputbox correspond à une valeur de ma cellule B alors je
sélectionne la valeur en cellule A qui est le nom d'un fichier. J'ouvre ensuite ce fichier
et je recherche une valeur ($cahier) en colonne B. Si la valeur est présente alors je copie certaines
valeurs de cette ligne dans ma première feuille de mon classeur sinon j'affiche un message
d'erreur.

Le problème est que la valeur que je recherche dans la feuille ouverte est parfois présente sur
plusieurs lignes.
J'aimerais donc que mon programme récupère toutes les valeurs demandé lorsque $cahier est présent.
J'ai essayé avec plusieurs code mais impossible de trouver la solution.

Si quelqu'un pouvait m'aiguiller svp.

Sub recherche()

Dim i As Long
Dim j As Long
Dim l As Long
Dim req As String
Dim Fichier As String
Dim CheminFichier As String
Dim celluletrouvee As Range
Dim indice As String
Dim ligne As Long
Dim col As Long

CheminFichier = "C: ..."

re:

req = InputBox("Renseignez un nom")

If req = "" Then
    MsgBox "Vous n'avez rien saisie"
    GoTo re
End If

If req <> "" Then

Application.ScreenUpdating = False

i = 2
j = 2
l = 1

    Do While Sheets("donnees").Cells(i, 2).Value <> ""
    
    
        If req = Sheets("donnees").Cells(i, 2).Value Then
        
            Fichier = Sheets("donnees").Cells(i, 1).Value
        
            Workbooks.Open (CheminFichier & Fichier)
                
                indice = "$cahier"
       
                 Set celluletrouvee = Range("B16:B100").Find(indice, lookat:=xlWhole)
                
                If celluletrouvee Is Nothing Then
                    MsgBox ("Aucun nom ne correspond")
                Else
                
                    ligne = celluletrouvee.Row 'k
                    col = celluletrouvee.Column                  
                   
kol:                
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, l).Value = Cells((ligne - 1), (col + 1)).Value                  
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, (l + 1)).Value = Cells((ligne - 1), (col + 3)).Value                    
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, (l + 2)).Value = Cells((ligne - 1), (col + 4)).Value                    
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, (l + 3)).Value = Cells((ligne - 1), (col + 5)).Value                    
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, 5).Value = Workbooks("Programme.xlsm").Sheets("donnees").Cells(i, 1).Value


		    ligne = ligne + 1

                        If celluletrouvee <> "" Then
                        
                         Do While Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, l).Value <> ""
                           
                            l = l + 1
                            
                          Loop
                                    
                            GoTo kol
                    
                           
                         End If


  		Workbooks(Fichier).Close (True)

                End If
                 
                
        j = j + 1

        End If

        i = i + 1
    Loop
end if

end Sub

A voir également:

Vba rechercher une valeur dans une ligne
Rechercher ou saisir une url - Guide
Partager photos en ligne - Guide
Aller à la ligne dans une cellule excel - Guide
Rechercher une chanson - Guide
Rechercher une image - Guide

4 réponses

Réponse 1 / 4

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Bonjour,

Juste pour le problème Valeur sur plusieurs lignes

déclarations:

Dim Plage as range
Dim Ligne as Byte 'tu ne vas que de 6 à 100
suppression de cellule trouvée
et
suppression de col
tu cherches "$cahier" dans la colonne B donc Col sera toujours égale à "B" (ou 2)

je n'ai pas regardé les imbrications avec i et j peut ^tre avant ou après le next.. à toi de voir

Workbooks.Open (CheminFichier & Fichier)
                indice = "$cahier"
                Set Plage = Sheets(1).Range("B16:B100") 'sheets non précisé à adapter
                    nbre = Application.CountIf(Plage, indice)
                    If nbre = 0 Then
                        ligne = 15
                        For Cptr = 1 To nbre
                            ligne = Plage.Find(indice, Cells(ligne, "B"), lookat:=xlWhole).Row
                            With Workbooks("Programme.xlsm").Sheets("Inv")
                                .Cells(j, (l + 1)).Value = Cells((ligne - 1), "C")
                                '... etc
                            End With
                        Next
                    End If
                Else
                    'msgbox.....

Michel