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
| Function Zone(Nom As String, ColSource As Range) As Range
'On recherche les lignes correspondant au critère Nom dans la colonne
Dim aCellFind As Range
'On cherche le Nom dans cette colonne
Set aCellFind = ColSource.Find(Nom, , xlValues, xlWhole, MatchCase:=False)
'On teste le résultat
If aCellFind Is Nothing Then
'Non trouvé
Exit Function
Else
'Trouvé
'On pointe la feuille de travail
With ColSource.Worksheet
'On pointe la plage en cherchant la cellule non vide qui suit
Set Zone = .Range(aCellFind, aCellFind.End(xlDown).Offset(-1))
End With
End If
End Function
Sub Test2()
Dim CellDestiC As Range
'Dim TypeDesti As String, RaceDesti As String
Dim SheetBase As Worksheet
Dim ZoneType As Range, ZoneRace As Range, ZoneCouleur As Range
Set SheetBase = Feuil1 'ici on utilise le CodeName de la feuille (ça n'est pas le nom de la feuille dans l'onglet)
'On pointe sur la feuille contenant le tableau à remplire
With Feuil2
'On boucle sur les cellule de la colonne C
For Each CellDestiC In .Range("C6", .Cells(.Rows.Count, "C").End(xlUp))
'On agit en fonction du contenu de la cellule
'On ne traite pas les lignes contenant un underscore
If CellDestiC.Offset(, -1) = "_" Then
'On masque la ligne
CellDestiC.Offset(, -1).EntireRow.Hidden = True
ElseIf CellDestiC.Value = "Type" Then
' 'On mémorise le type pour la suite
' TypeDesti = CellDestiC.Offset(, -1).Value
'On pointe la partie de la colonne qui se référe à TypeDesti
Set ZoneType = Zone(CellDestiC.Offset(, -1).Value, SheetBase.Range("D2", SheetBase.Cells(SheetBase.Rows.Count, "D").End(xlUp)))
'La 1ère ligne contient la valeur recherchée, on va y chercher les Codes
CellDestiC.Offset(, 1).Value = ZoneType.Resize(1).Offset(, 4).Value
ElseIf CellDestiC.Value = "Race" Then
' 'On mémorise la race
' RaceDesti = CellDestiC.Offset(, -1).Value
'On pointe la zone de recheche en décalant la zone type vers la droite
Set ZoneRace = ZoneType.Offset(, 1)
'On recherche la ZoneRace
Set ZoneRace = Zone(CellDestiC.Offset(, -1).Value, ZoneRace)
'La 1ère ligne contien la race et son code assicié
CellDestiC.Offset(, 1).Value = ZoneRace.Resize(1).Offset(, 3).Value
ElseIf CellDestiC.Value = "Couleur" Then
'On pointe la zone de recheche en décalant la zone type vers la droite
Set ZoneCouleur = ZoneType.Offset(, 2)
'On recherche la ZoneCouleur
Set ZoneCouleur = Zone(CellDestiC.Offset(, -1).Value, ZoneCouleur)
'La 1ère (et seule) ligne contien la Couleur et son code assicié
CellDestiC.Offset(, 1).Value = ZoneCouleur.Resize(1).Offset(, 2).Value
End If
Next
End With
End Sub |
