Discussion :

[nubed]

Bonjour à tous,

Je fais appel à votre expertise sur la création d’un formulaire avec une zone de recherche.

Je travaille sur des indicateurs de fiabilisation qui sont répertoriés dans un classeur Excel selon des catégories, chaque catégorie est dans un onglet distinct.

Je souhaiterai créer une zone de recherche qui puisse selon le matricule m’afficher dans un onglet ‘destination’ les lignes caractéristiques du matricule.

Un matricule peut avoir plusieurs indicateurs dans une ou plusieurs familles, la volumétrie des informations étant importante (une vingtaine d’onglet avec 10K ligne mini) l’option ctrl F n’est pas adapté.
Par ailleurs j’ai tenté dans l’onglet ‘destination’ de créer des colonnes avec des rechercheV , pas très visuel et peu pratique (beaucoup de doublons sur les matricules, peu malléable) mon Excel est sensé être utilisé par des collaborateurs avec un niveau info proche du ….

Voici comment je compte m’y prendre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
PrivateSub textBox1_Change()
 
Dim y As Long
Dim i As Long
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim sel As Object   ' cellule trouvée
Dim c As Integer    ' colonne
Dim f As Integer    ' feuille
Dim l As Long       ' ligne
Set Sh1 = ThisWorkbook.Sheets("Source")
Set Sh2 = ThisWorkbook.Sheets("Destination")
 
Sheets("Source").Activate
 
x = Sh1.Range("A65536").End(xlUp).Row
y = Sh2.Range("A65536").End(xlUp).Row + 1
 
For f = 1 To Sheets.Count   ' boucle feuilles
With Sheets(f)
    l = 1: c = 1
    Do                      ' recherche
        Set sel = .Cells.Find(What:=NumMatricule, after:=.Cells(l, c), _
            LookIn:=xlValues, LookAt:=xlPart, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlNext, MatchCase:=False)
 
If sel Is Nothing Then Exit Do
        If sel.Column <= c And sel.Row <= l Then Exit Do
        c = sel.Column
        l = sel.Row
        n = n + 1       ' élément trouvé : traitement
    Loop
 
 
    If « Matricule » est dans un ou pls onglets Then
        Sh1.Range("A" & i & ":y" & i).Copy Destination:=Sh2.Range("A" & y)
        i = i + 1
Else Msgbox “pas de matricule correspondant”
    End If
    y = Sh2.Range("A" & Rows.Count).End(xlUp).Row + 1
Next
 
End Sub

Mes soucis/Questions :
1. L’incorporation de la macro devrait se faire dans ce type de private sub
Private Sub CommandButton1_Click()
…..
End Sub
Je rentre un matricule dans la zone de texte j’appuie sur le bouton magique avec la macro derrière. Je bloque sur cette étape
2. La recherche multi onglet, multi colonne de ma variable ‘matricule’

Je sais c’est (un tout petit peu ) le boxon donc pour résumer :
Zone de recherche saisie du matriculeClick sur bouton recherchesi trouvé dans onglets copier caractéristiques dans onglet ‘destination’sinon ‘matricule indisponible’.

J’espère avoir été assez claire (tout du moins plus que la macro ci-dessus )

Merci d’avance à tous les contributeurs.

[Igloobel]

Bonjour,

personellement je ne connait pas le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
do
...
loop

par contre je connais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
do while condition
...
loop
'ou
do
...
loop while condition

ou encore a la place de while mettre until

a+

[nubed]

Bonjour à tous,

J'ai réorganisé mon code comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Sub B_ok_Click()
   If Me.TextBox1 = "" Then Exit Sub
   Application.DisplayAlerts = False
   On Error Resume Next
   Sheets("Temp").Delete
   On Error GoTo 0
   Sheets.Add after:=Sheets(Sheets.Count)
   ActiveSheet.Name = "Temp"
   [A1] = Me.TextBox1
   ligne = 2
   For i = 1 To Sheets.Count - 1
    With Sheets(i).Cells
    Do                      ' recherche
        Set sel = .Cells.Find(What:=Me.TextBox1, after:=.Cells(.Cells.Count), _
            LookIn:=xlValues, LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False)
    Dim j As Long 'Position des déclarations de variables
    Dim y As Long
    Dim Sh1 As Worksheet 'toutes les feuilles du classeur sauf ma feuille de destination Temp
    Sh1.Range("A" & j & ":W" & j).Copy Destination:=Temp.Range("A" & y) 'soucis d'une source multi onglets vers une feuille de destination fixe
    j = j + 1
    y = Sh2.Range("A" & Rows.Count).End(xlUp).Row + 1
    Loop While Not sel Is Nothing
 
    End With
   Next i
End Sub

Je ne sais pas si je suis dans la bonne voie J'pense que je m'emmêle les pinceaux entre les différentes structures du code...

Une âme charitable pour me soutenir ?

Bonne journée à tous

[clementmarcotte]

Bonjour,

Bonjour,

personellement je ne connait pas le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
do
...
loop

a+

Cela peut marcher à la condition de mettre à quelque part dans la boucle un IF avec une condition qui mène (idéalement) à un Exit Do (ou à Exit Sub, End ou Stop); quand elle est vraie. Mais, le while et le until remplissent déjà le même rôle.

[Docmarti]

Bonjour.

Dans ton code, on trouve after:=.Cells(.Cells.Count).

Est-ce que la syntaxe .Cells(.Cells.Count) est correcte?

Pour le vérifier, mets-le dans un MsgBox ainsi.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
With Sheets(i).Cells
    MsgBox .Cells(.Cells.Count).Address

[nubed]

Bonjour à tous,

Avec un peu d'astuce et beaucoup de recherche j'ai fini ma macro:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub RechercheV()
 
Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer
 
myText = InputBox("Entrez le matricule ou le linom")
 
If myText = "" Then Exit Sub
 
For Each ws In ThisWorkbook.Worksheets
With ws
'Ne pas rechercher de valeur dans la feuille List
If ws.Name = "List" Then GoTo myNext
 
Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
 
If Not Found Is Nothing Then
FirstAddress = Found.Address
 
Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
 
Set Found = .UsedRange.FindNext(Found)
 
'Copie les données dans la feuille List
Found.EntireRow.Copy _
Destination:=Worksheets("List").Range("A65536").End(xlUp).Offset(1, 0)
Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
 
myNext:
End With
 
Next ws
 
If Len(AddressStr) Then
MsgBox "Trouvé: """ & myText & """ " & foundNum & " fois." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:
 
MsgBox "Aucun résultat " & myText & " dans ce classeur.", vbExclamation
End If
End Sub

J'espère que ça pourra aider.

A bientôt !