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 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