Discussion :

[sisko74]

Bonjour,

J'essaie de boucler dans une feuille pour trouver les données relatives à un entête.
J'y parviens pour le premier mais ensuite je voudrais boucler pour trouver l’entête suivant et les données qui vont bien et ainsi de suite.
Je pense que la solution et "findnext" vu que mon premier entête et trouvé par "find" mais je ne parviens pas à le mettre en œuvre.

Je suis sais que mon code doit pas être top, mais je découvre VBA en tâtonnant.
Je suis preneur de quelques pistes.

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
46
47
48
49
50
51
52
53
Sub Cherche()
'déclaration des variables :
Dim IdPdc As Range
Dim ZoneRechPdc As Range
Dim RechTournee As Range
Dim RechPli As Range
Dim Valeur_Date As Range
Dim Valeur_Pdc As String
Dim Valeur_Tournée As String
Dim i As Integer
 
Valeur_Pdc = "a9"
Set ZoneRechPdc = Sheets("Sheet1").Columns(2)
Set IdPdc = ZoneRechPdc.Cells.Find(What:=Valeur_Pdc)
 
'entete de colonne
Sheets("Attendu").Range("A1") = "Jour"
Sheets("Attendu").Range("B1") = "PDC"
Sheets("Attendu").Range("C1") = "QL"
Sheets("Attendu").Range("D1") = "Nbre de Plis"
 
 
'recuperer PDC
Sheets("Attendu").Range("B2") = IdPdc
Sheets("Attendu").Range("B2") = Right(Range("B2"), Len(Range("B2")) - 7)
 
'recuperer données
  For i = 1 To 20
 
 Set RechTournee = IdPdc.Offset(4 + i, -1)
 
Sheets("Attendu").Range("C" & i + 1) = RechTournee
 
Set RechPli = RechTournee.Offset(0, 1)
Sheets("Attendu").Range("D" & i + 1) = RechPli
 
 If RechTournee = "Total" Then
  Exit For
 End If
 
Next
 
'recuperer la date
 
Set Valeur_Date = IdPdc.Offset(0, 6)
 
Sheets("Attendu").Range("A2") = Format(Valeur_Date, "dd/mm/yyyy")
Sheets("Attendu").Range("A2") = Left(Range("A2"), 10)
 
 
 
 
End Sub

test.xls

[Kimy_Ire]

Bonjour sisko74,

Personnellement, je préfère faire un For Each avec la fonction FindAll du net (équivalent du FindNext).
Voici un petit exemple tout simple qui affiche les adresses. Je te laisse le modifier pour ton besoin.

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
Option Explicit
 
Sub RechercherTout()
'Déclaration des variables
Dim oRng As Range, oCell As Range
Dim oToFind As String
 
'Avec la Feuil1
With Worksheets("Feuil1")
    'On définie oToFind sur la valeur qu'on cherche, ici A1.
    oToFind = .Range("A1")
 
    'On effectue le FindAll qui fait une union de toutes les ranges trouvées sur la plage de recherche (ici la colonne 2)
    Set oRng = FindAll(.Columns(2), oToFind)
 
    'Si on trouve au moins une valeur dans oRng
    If Not oRng Is Nothing Then
        'On boucle sur l'ensemble des cellules trouvées
        For Each oCell In oRng
            '***** METTRE ICI LE CODE SOUHAITE POUR CHAQUE CELLULE ****'
            'afin d'en afficher l'adresse
            MsgBox oCell.Address
        Next oCell
    End If
End With
 
End Sub

Au passage, je te passe la fonction FindAll, que tu peux trouver de différentes manières, d'ailleurs.

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Function FindAll(SearchRange As Range, _
                FindWhat As Variant, _
               Optional LookIn As XlFindLookIn = xlValues, _
                Optional LookAt As XlLookAt = xlWhole, _
                Optional SearchOrder As XlSearchOrder = xlByRows, _
                Optional MatchCase As Boolean = False, _
                Optional BeginsWith As String = vbNullString, _
                Optional EndsWith As String = vbNullString, _
                Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAll
' This searches the range specified by SearchRange and returns a Range object
' that contains all the cells in which FindWhat was found. The search parameters to
' this function have the same meaning and effect as they do with the
' Range.Find method. If the value was not found, the function return Nothing. If
' BeginsWith is not an empty string, only those cells that begin with BeginWith
' are included in the result. If EndsWith is not an empty string, only those cells
' that end with EndsWith are included in the result. Note that if a cell contains
' a single word that matches either BeginsWith or EndsWith, it is included in the
' result.  If BeginsWith or EndsWith is not an empty string, the LookAt parameter
' is automatically changed to xlPart. The tests for BeginsWith and EndsWith may be
' case-sensitive by setting BeginEndCompare to vbBinaryCompare. For case-insensitive
' comparisons, set BeginEndCompare to vbTextCompare. If this parameter is omitted,
' it defaults to vbTextCompare. The comparisons for BeginsWith and EndsWith are
' in an OR relationship. That is, if both BeginsWith and EndsWith are provided,
' a match if found if the text begins with BeginsWith OR the text ends with EndsWith.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
Dim FoundCell As Range
Dim FirstFound As Range
Dim LastCell As Range
Dim ResultRange As Range
Dim XLookAt As XlLookAt
Dim Include As Boolean
Dim CompMode As VbCompareMethod
Dim Area As Range
Dim MaxRow As Long
Dim MaxCol As Long
Dim BeginB As Boolean
Dim EndB As Boolean
 
 
CompMode = BeginEndCompare
If BeginsWith <> vbNullString Or EndsWith <> vbNullString Then
    XLookAt = xlPart
Else
    XLookAt = LookAt
End If
 
' this loop in Areas is to find the last cell
' of all the areas. That is, the cell whose row
' and column are greater than or equal to any cell
' in any Area.
 
For Each Area In SearchRange.Areas
    With Area
        If .Cells(.Cells.Count).Row > MaxRow Then
            MaxRow = .Cells(.Cells.Count).Row
        End If
        If .Cells(.Cells.Count).Column > MaxCol Then
            MaxCol = .Cells(.Cells.Count).Column
        End If
    End With
Next Area
Set LastCell = SearchRange.Worksheet.Cells(MaxRow, MaxCol)
 
On Error GoTo 0
Set FoundCell = SearchRange.Find(what:=FindWhat, _
        after:=LastCell, _
        LookIn:=LookIn, _
        LookAt:=XLookAt, _
        SearchOrder:=SearchOrder, _
        MatchCase:=MatchCase)
 
If Not FoundCell Is Nothing Then
    Set FirstFound = FoundCell
    Do Until False ' Loop forever. We'll "Exit Do" when necessary.
        Include = False
        If BeginsWith = vbNullString And EndsWith = vbNullString Then
            Include = True
        Else
            If BeginsWith <> vbNullString Then
                If StrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, BeginEndCompare) = 0 Then
                    Include = True
                End If
            End If
            If EndsWith <> vbNullString Then
                If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, BeginEndCompare) = 0 Then
                    Include = True
                End If
            End If
        End If
        If Include = True Then
            If ResultRange Is Nothing Then
                Set ResultRange = FoundCell
            Else
                Set ResultRange = Application.Union(ResultRange, FoundCell)
            End If
        End If
        Set FoundCell = SearchRange.FindNext(after:=FoundCell)
        If (FoundCell Is Nothing) Then
            Exit Do
        End If
        If (FoundCell.Address = FirstFound.Address) Then
            Exit Do
        End If
 
    Loop
End If
 
Set FindAll = ResultRange
 
End Function

En espérant que cela te serve !

Cordialement,
Kimy

[sisko74]

Merci pour ton aide, j'avance