| 12
 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 SelCell()
 
'Récupère les coordonnées des Cellules de la base de données
'Et les scinde
 
Dim objCell As Range, PremAdresse As String, PlageResult As Range, SelSerie
Dim I As Long, PlageSerie As Range
 
Range("e2", Range("e2").EntireColumn.Find(what:="*", searchdirection:=xlPrevious)).Select
Selection.Name = "SelSerie"
SelRes = Range("SelSerie").Offset(0, 1).Select
Selection.Name = "SelRes"
 
Set PlageSerie = Range("SelSerie")
 
 For I = 1 To PlageSerie.Cells.Count
 
Suite:
    NumSerie = Range("SelSerie")(I)
    If IsEmpty(NumSerie) Then
    I = I + 1
    GoTo Suite
    End If
    Set PlageResult = Nothing
 SelDesi = Range("b2", Range("b2").EntireColumn.Find(what:="*", searchdirection:=xlPrevious)).Select
'selectionne la plage de données concernées
 
        With Selection
 
        Set objCell = .Find(what:=NumSerie, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext)
        If Not objCell Is Nothing Then
            Set PlageResult = Nothing
            PremAdresse = objCell.Address
            Do
                If PlageResult Is Nothing Then
                    Set PlageResult = objCell
                Else
                    Set PlageResult = Application.Union(objCell, PlageResult)
                End If
                Set objCell = .FindNext(objCell)
            Loop While Not objCell Is Nothing And objCell.Address <> PremAdresse
        End If
        End With
 
        If PlageResult Is Nothing Then
            Range("SelRes")(I) = "numéro de série non trouvé"
        Else
            Range("SelRes")(I) = PlageResult.Address
        End If
 
 
    Next I
End Sub | 
Partager