Problème Feuille RechFind
Fermé
max-iime
Messages postés
30
Date d'inscription
dimanche 22 novembre 2015
Statut
Membre
Dernière intervention
23 mars 2019
-
Modifié le 6 juil. 2017 à 11:41
thev Messages postés 1852 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 23 avril 2024 - 7 juil. 2017 à 17:05
thev Messages postés 1852 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 23 avril 2024 - 7 juil. 2017 à 17:05
A voir également:
- Problème Feuille RechFind
- Feuille de pointage excel - Télécharger - Tableur
- Feuille a5 - Guide
- Supprimer une feuille word - Guide
- Feuille de style word - Guide
- Verrouiller cellule excel sans verrouiller la feuille - Guide
2 réponses
thev
Messages postés
1852
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
23 avril 2024
681
7 juil. 2017 à 11:22
7 juil. 2017 à 11:22
Bonjour,
"b" n'est pas une variable Chaîne mais une variable objet correspondant à la feuille . Pour être en accord avec ta fonction
"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
ThauTheme
Messages postés
1442
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
29 juillet 2022
160
6 juil. 2017 à 16:27
6 juil. 2017 à 16:27
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...
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...
max-iime
Messages postés
30
Date d'inscription
dimanche 22 novembre 2015
Statut
Membre
Dernière intervention
23 mars 2019
7 juil. 2017 à 09:07
7 juil. 2017 à 09:07
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.
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
7 juil. 2017 à 12:09
Heu... Merci Thev, parce que là j'avoue que j'avais pas le courage de m'y pencher...
7 juil. 2017 à 12:40
Modifié le 7 juil. 2017 à 13:37
Merci beaucoup ça marche parfaitement :)
Dernière question, j'aimerais créer une boucle sur ce code avec le
Mais ça me met une erreur dessus (Incompatibilité de type)
j'ai essayé avec ça mais ça ne fonctionne pas
Modifié le 7 juil. 2017 à 17:06
il faut utliser une boucle For each ... Next avec une variable Tableau.