Problème Feuille RechFind

max-iime Messages postés 31 Statut Membre -  
thev Messages postés 2010 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour à tous et à toute,

J'ai une macro pour faire une recherche dans plusieurs classeur avec la fonction RechFind, je recherche dans 5 feuilles donc j'ai 5 fois la RechFind. je veux créer une boucle pour avoir seulement une fois la fonction RechFind.

J'ai déclarer le nom de mes feuilles: 
Dim a As Worksheet
Dim b As Worksheet
Dim c As Worksheet

Set a = Sheets("Tableau_de_Bord")             
Set b = Sheets("Base de données")      
Set c = Sheets("Actu")


jusque là tout va bien ^^

La où je galère c'est intégrer les variables dans la RechFind. 
m = RechFind(a.Range("B7"), ThisWorkbook.Name, b, ("A2:BB500"), TB())

m est bien déclaré avant.
La variable fonctionne bien mais pas la b, j'ai essayé plusieurs truc mais impossible de trouver quelque chose qui fonctionne :/

Comme message d'erreur j'ai :

Erreur d'exécution'438':
Propriété ou méthode non géré par cet objet

Merci d'avance.

2 réponses

  1.
    thev Messages postés 2010 Date d'inscription   Statut Membre Dernière intervention   723
     
    Bonjour,

    "b" n'est pas une variable Chaîne mais une variable objet correspondant à la feuille . Pour être en accord avec ta fonction 
    dim b as string
    b = Sheets("Base de données").Name

     
    1
    1. ThauTheme Messages postés 1564 Statut Membre 160
       
      Bonjour le fil, bonjour le forum,

      Heu... Merci Thev, parce que là j'avoue que j'avais pas le courage de m'y pencher...
      0
      1. thev Messages postés 2010 Date d'inscription   Statut Membre Dernière intervention   723 > ThauTheme Messages postés 1564 Statut Membre
         
        C'est vrai que le code est conséquent mais a priori l'examen de celui relatif à la fonction est suffisant pour détecter l'anomalie.
        0
    2. max-iime Messages postés 31 Statut Membre
       
      Bonjour Thev,

      Merci beaucoup ça marche parfaitement :)

      Dernière question, j'aimerais créer une boucle sur ce code avec le 
      For i = b To g

      Mais ça me met une erreur dessus (Incompatibilité de type) 

      For i = b To g
m = RechFind(a.Range("B7"), ThisWorkbook.Name, i, ("A2:BB500"), TB())
    If m > 0 Then
        For n = 0 To m - 1 ' ou ubound(TB)
            'exemple
            Sheets("Feuil1").Cells(n + 2, 1) = TB(n)
        Next n
    End If
Next i


      j'ai essayé avec ça mais ça ne fonctionne pas 
      For i = Asc("a") To Asc("g")
      0
      1. thev Messages postés 2010 Date d'inscription   Statut Membre Dernière intervention   723 > max-iime Messages postés 31 Statut Membre
         
        La boucle For....Next requiert comme variable un entier, ce qui n'est pas ton cas.
        il faut utliser une boucle For each ... Next avec une variable Tableau. 
        For Each nom_i in Array("Station1","Station2",...)
            m = RechFind(a.Range("B7"), ThisWorkbook.Name, nom_i, ("A2:BB500"), TB())
        .....
        Next nom_i
        0
  2. ThauTheme Messages postés 1564 Statut Membre 160
     
    Bonjour Maxime, bonjour le forum,

    Pas très clair tout ça !... Tu parles de recherche dans plusieurs classeurs puis tu utilises des variables Worksheet (onglet) !?...
    Sans le code complet, difficile d'en savoir plus...
    0
    1. max-iime Messages postés 31 Statut Membre
       
      Bonjour ThauTheme,

      Je me suis trompé je voulais dire plusieurs Feuille.
      ça c'est le code qui fonctionne et je veux mettre des boucle pour qu'il soit plus rapide et plus lisible. 

      Sub RechMulti()
Dim start As Single
start = Timer
Application.ScreenUpdating = False
Rows("21:3000").Select
    Selection.Delete Shift:=xlUp
Range("D12:D17").Select
    Selection.ClearContents
    Range("A1").Select
Dim d As Range, txt As String
Dim ws As Worksheet
Dim TNL As Variant
Dim a As Long

    Dim n As Long, Nb As Long
    For u = 1 To 6
    Set ws = Sheets.Add
    ws.Name = "Feuil" & u
    Next u





Dim R As Long, TB()
Dim i As Integer

R = RechFind(Sheets("Tableau de Bord").Range("B7"), ThisWorkbook.Name, "Station1", "A2:BB500", TB())
    If R > 0 Then
        For i = 0 To R - 1 ' ou ubound(TB)
            'exemple
            Sheets("Feuil1").Cells(i + 2, 1) = TB(i)
        Next i
       
    End If

R = RechFind(Sheets("Tableau de Bord").Range("B7"), ThisWorkbook.Name, "Station2", "A2:BB500", TB())
    If R > 0 Then
        For i = 0 To R - 1 ' ou ubound(TB)
            'exemple
            Sheets("Feuil2").Cells(i + 2, 1) = TB(i)
        Next i
        
    End If

R = RechFind(Sheets("Tableau de Bord").Range("B7"), ThisWorkbook.Name, "PIT", "A2:BB500", TB())
    If R > 0 Then
        For i = 0 To R - 1 ' ou ubound(TB)
            'exemple
            Sheets("Feuil3").Cells(i + 2, 1) = TB(i)
        Next i
    End If

R = RechFind(Sheets("Tableau de Bord").Range("B7"), ThisWorkbook.Name, "PBT", "A2:BB500", TB())
    If R > 0 Then
        For i = 0 To R - 1 ' ou ubound(TB)
            'exemple
            Sheets("Feuil4").Cells(i + 2, 1) = TB(i)
        Next i
    End If

R = RechFind(Sheets("Tableau de Bord").Range("B7"), ThisWorkbook.Name, "CT", "A2:BB500", TB())
    If R > 0 Then
        For i = 0 To R - 1 ' ou ubound(TB)
            'exemple
            Sheets("Feuil5").Cells(i + 2, 1) = TB(i)
        Next i
    End If

R = RechFind(Sheets("Tableau de Bord").Range("B7"), ThisWorkbook.Name, "GT", "A2:BB500", TB())
    If R > 0 Then
        For i = 0 To R - 1 ' ou ubound(TB)
            'exemple
            Sheets("Feuil6").Cells(i + 2, 1) = TB(i)
        Next i
    End If


    Sheets("Feuil1").Select
    Cells.Select
    Selection.Replace What:="$", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
Sheets("Feuil1").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each d In Selection
txt = ""
For i = 1 To Len(d.Value)
If Asc(Mid(d.Value, i, 1)) < 58 Then
txt = txt & Mid(d.Value, i, 1)
End If
Next i
d.Value = txt
Next d
 Sheets("Feuil1").Select
If Application.CountA(Range("$A$1:$A$2000" & dlg)) > 0 Then
Columns("A:A").Select
    ActiveSheet.Range("$A$1:$A$2000").RemoveDuplicates Columns:=1, Header:=xlNo
    
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(2, 0).Select
    ActiveCell.FormulaR1C1 = "Station1"
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Font.Size = 16
    
    Sheets("Station1").Select
    Range("Station1[[#Headers],[Nom]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

    With Worksheets("feuil1")
        TNL = .Range("A1").CurrentRegion        'mise en memoire plage de cellules
        Nb = UBound(TNL)        'Nombre de valeurs dans table
    End With
    'Boucle sur table de valeurs
    a = Sheets("Tableau de Bord").Range("A65536").End(xlUp).Offset(1, 0).Row
    For n = 2 To Nb
        Sheets("Station1").Rows(TNL(n, 1)).Copy Sheets("Tableau de Bord").Cells(n + a - 2, 1)
    Next n
End If


 Sheets("Feuil2").Select
    Cells.Select
    Selection.Replace What:="$", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   
Sheets("Feuil2").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each d In Selection
txt = ""
For i = 1 To Len(d.Value)
If Asc(Mid(d.Value, i, 1)) < 58 Then
txt = txt & Mid(d.Value, i, 1)
End If
Next i
d.Value = txt
Next d
Sheets("Feuil2").Select
        
If Application.CountA(Range("$A$1:$A$2000" & dlg)) > 0 Then
Columns("A:A").Select
    ActiveSheet.Range("$A$1:$A$2000").RemoveDuplicates Columns:=1, Header:=xlNo
    
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(2, 0).Select
    ActiveCell.FormulaR1C1 = "Station2"
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Font.Size = 16
    
    Sheets("Station2").Select
    Range("Station2[[#Headers],[Nom]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
   
    With Worksheets("feuil2")
        TNL = .Range("A1").CurrentRegion        'mise en memoire plage de cellules
        Nb = UBound(TNL)        'Nombre de valeurs dans table
    End With
    'Boucle sur table de valeurs

    a = Sheets("Tableau de Bord").Range("A65536").End(xlUp).Offset(1, 0).Row
    For n = 2 To Nb
        Sheets("Station2").Rows(TNL(n, 1)).Copy Sheets("Tableau de Bord").Cells(n + a - 2, 1)
    Next n
End If



Sheets("Feuil3").Select
    Cells.Select
    Selection.Replace What:="$", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   
Sheets("Feuil3").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each d In Selection
txt = ""
For i = 1 To Len(d.Value)
If Asc(Mid(d.Value, i, 1)) < 58 Then
txt = txt & Mid(d.Value, i, 1)
End If
Next i
d.Value = txt
Next d
If Application.CountA(Range("$A$1:$A$2000" & dlg)) > 0 Then
Columns("A:A").Select
    ActiveSheet.Range("$A$1:$A$2000").RemoveDuplicates Columns:=1, Header:=xlNo
    
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(2, 0).Select
    ActiveCell.FormulaR1C1 = "PIT"
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Font.Size = 16
    
    Sheets("PIT").Select
    Range("PIT[[#Headers],[CRC]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
   
    With Worksheets("feuil3")
        TNL = .Range("A1").CurrentRegion        'mise en memoire plage de cellules
        Nb = UBound(TNL)        'Nombre de valeurs dans table
    End With
    'Boucle sur table de valeurs
    a = Sheets("Tableau de Bord").Range("A65536").End(xlUp).Offset(1, 0).Row
    For n = 2 To Nb
        Sheets("PIT").Rows(TNL(n, 1)).Copy Sheets("Tableau de Bord").Cells(n + a - 2, 1)
    Next n
End If

Sheets("Feuil4").Select
    Cells.Select
    Selection.Replace What:="$", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   
Sheets("Feuil4").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each d In Selection
txt = ""
For i = 1 To Len(d.Value)
If Asc(Mid(d.Value, i, 1)) < 58 Then
txt = txt & Mid(d.Value, i, 1)
End If
Next i
d.Value = txt
Next d
If Application.CountA(Range("$A$1:$A$2000" & dlg)) > 0 Then
Columns("A:A").Select
    ActiveSheet.Range("$A$1:$A$2000").RemoveDuplicates Columns:=1, Header:=xlNo
    
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(2, 0).Select
    ActiveCell.FormulaR1C1 = "PBT"
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Font.Size = 16
    
    Sheets("PBT").Select
    Range("PBT[[#Headers],[Commune]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
   
    With Worksheets("feuil4")
        TNL = .Range("A1").CurrentRegion        'mise en memoire plage de cellules
        Nb = UBound(TNL)        'Nombre de valeurs dans table
    End With
    'Boucle sur table de valeurs
    a = Sheets("Tableau de Bord").Range("A65536").End(xlUp).Offset(1, 0).Row
    For n = 2 To Nb
        Sheets("PBT").Rows(TNL(n, 1)).Copy Sheets("Tableau de Bord").Cells(n + a - 2, 1)
    Next n
End If

Sheets("Feuil5").Select
    Cells.Select
    Selection.Replace What:="$", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   
Sheets("Feuil5").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each d In Selection
txt = ""
For i = 1 To Len(d.Value)
If Asc(Mid(d.Value, i, 1)) < 58 Then
txt = txt & Mid(d.Value, i, 1)
End If
Next i
d.Value = txt
Next d
If Application.CountA(Range("$A$1:$A$10000" & dlg)) > 0 Then
Columns("A:A").Select
    ActiveSheet.Range("$A$1:$A$10000").RemoveDuplicates Columns:=1, Header:=xlNo
    
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(2, 0).Select
    ActiveCell.FormulaR1C1 = "CT"
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Font.Size = 16
    
    Sheets("CT").Select
    Range("CT[[#Headers],[Nom]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
   
    With Worksheets("feuil5")
        TNL = .Range("A1").CurrentRegion        'mise en memoire plage de cellules
        Nb = UBound(TNL)        'Nombre de valeurs dans table
    End With
    'Boucle sur table de valeurs
    a = Sheets("Tableau de Bord").Range("A65536").End(xlUp).Offset(1, 0).Row
    For n = 2 To Nb
        Sheets("CT").Rows(TNL(n, 1)).Copy Sheets("Tableau de Bord").Cells(n + a - 2, 1)
    Next n
End If

Sheets("Feuil6").Select
    Cells.Select
    Selection.Replace What:="$", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   
Sheets("Feuil6").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each d In Selection
txt = ""
For i = 1 To Len(d.Value)
If Asc(Mid(d.Value, i, 1)) < 58 Then
txt = txt & Mid(d.Value, i, 1)
End If
Next i
d.Value = txt
Next d
If Application.CountA(Range("$A$1:$A$2000" & dlg)) > 0 Then
Columns("A:A").Select
    ActiveSheet.Range("$A$1:$A$2000").RemoveDuplicates Columns:=1, Header:=xlNo
    
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(2, 0).Select
    ActiveCell.FormulaR1C1 = "GT"
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Font.Size = 16
    
    Sheets("GT").Select
    Range("GT[[#Headers],[Code société]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Tableau de Bord").Select
    Range("A1048576").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
   
    With Worksheets("feuil6")
        TNL = .Range("A1").CurrentRegion        'mise en memoire plage de cellules
        Nb = UBound(TNL)        'Nombre de valeurs dans table
    End With
    'Boucle sur table de valeurs
    a = Sheets("Tableau de Bord").Range("A65536").End(xlUp).Offset(1, 0).Row
    For n = 2 To Nb
        Sheets("GT").Rows(TNL(n, 1)).Copy Sheets("Tableau de Bord").Cells(n + a - 2, 1)
    Next n
End If
Sheets("Feuil1").Select
X = Application.WorksheetFunction.CountA(Range("A1:A" & Range("A65536").End(xlUp).Row))
        Sheets("Tableau de Bord").Range("D12") = X
        
        Sheets("Feuil2").Select
X = Application.WorksheetFunction.CountA(Range("A1:A" & Range("A65536").End(xlUp).Row))
        Sheets("Tableau de Bord").Range("D13") = X
        Sheets("Feuil3").Select
X = Application.WorksheetFunction.CountA(Range("A1:A" & Range("A65536").End(xlUp).Row))
        Sheets("Tableau de Bord").Range("D14") = X
        Sheets("Feuil4").Select
X = Application.WorksheetFunction.CountA(Range("A1:A" & Range("A65536").End(xlUp).Row))
        Sheets("Tableau de Bord").Range("D15") = X
        Sheets("Feuil5").Select
X = Application.WorksheetFunction.CountA(Range("A1:A" & Range("A65536").End(xlUp).Row))
        Sheets("Tableau de Bord").Range("D16") = X
        Sheets("Feuil6").Select
X = Application.WorksheetFunction.CountA(Range("A1:A" & Range("A65536").End(xlUp).Row))
        Sheets("Tableau de Bord").Range("D17") = X
   Application.DisplayAlerts = False
    
    Sheets("Feuil1").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Feuil2").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Feuil3").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Feuil4").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Feuil5").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Feuil6").Select
    ActiveWindow.SelectedSheets.Delete

    Application.DisplayAlerts = True
   
    Sheets("Tableau de Bord").Select
    Range("A21:FE1267").Select
    Selection.RowHeight = 14.5
    Range("B32").Select
Range("A21:CQ1120").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="=$B$7", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("A1").Select


Application.ScreenUpdating = True
MsgBox "durée du traitement: " & Timer - start & " secondes"

End Sub

'Retourne toutes les adresses trouvées dans la recherche
'WkbN = nom du classeur, avec cette donnée la fonction peut être mise dans un xla
'WksN = nom de la feuille
'Plage = les coordonnées de la plage à parcourir.
'Retour dans le tableau donner en argument.
Function RechFind(ByVal Cle As String, ByVal WkbN As String, ByVal WksN As String, ByVal Plage As String, ByRef TBadress() As Variant) As Long
Dim Cherche, Ix As Long, PrAddress
    With Workbooks(WkbN).Sheets(WksN).Range(Plage)
        Set Cherche = .Find(Cle)
        If Not Cherche Is Nothing Then
            PrAddress = Cherche.Address
            Do
                ReDim Preserve TBadress(Ix)
                TBadress(Ix) = Cherche.Address
                Set Cherche = .FindNext(Cherche)
                Ix = Ix + 1
            Loop While Not Cherche Is Nothing And Cherche.Address <> PrAddress
        End If
    End With
    'nombre d'occurence(s) trouvée(s), Retour 0 si aucune occurence
    RechFind = Ix
    Set Cherche = Nothing 'Libére la mémoire occupée par l'objet.
End Function
      0

Discussions similaires

Feuille de score belote
nulleeninfo -
brucine -

7 réponses
feuille excel de gestion belote
SiFaSiLa -
frank -

2 réponses
grille de points pour belote
portos54 -
antoine.let -

7 réponses
Imprimer un document paysage A3 avec deux feuilles A4
nikoss -
Lilo -

10 réponses
Faire une feuille minutes (métrés) sous VBA
Doriantino -
Doriantino -

4 réponses