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
| Option Explicit ' Recherche la ville selon le type du trajet et le sens départ / arrivée
' =============================== Description de la feuille des voyages
Public Const rowPoint = 1 ' Rangée du point de départ ou d'arrivée
Public Const rowTravelStart = 6 ' Rangée du premier voyage
Public Const colCity = 2 ' La colonne B est le nom de la ville
Public Const colPoint = colCity + 1 ' Colonne C : point "DEPART" / "ARRIVEE" en C1
Public Const colNational = colPoint ' Colonne C : "national" ou "#N/A" ou "" à partir de C6
Public Const pointDeparture = "DEPART"
Public Const pointArrival = "ARRIVEE"
Public Const colTravel = colPoint + 1 ' En colonne D on trouve le type du voyage
Public Const typeNational = "national" ' Application de la formule strFormulaNational
Public Const indType = 0 ' Première dimension dans le tableau le plus interne de varTravel
Public Const indDeparture = indType + 1 ' Dimension suivante pour la ville de "DEPART"
Public Const indArrival = indDeparture + 1 ' Dernière dimension pour la ville d'"ARRIVEE"
' =============================== Classeur externe matrice.xls pour la formule nationale
Public Const nameXlsHermes = "P:\Commun\Transport Securité\Docs Madjid\[matrice.xls]matrice hermes"
Public Const strFormulaNational = "=VLOOKUP(RC[2],'" + nameXlsHermes + "'!R1C1:R800C3,3,0)"
' Recherche la ville selon le type du trajet et le sens départ / arrivée
Sub TravelCity()
Dim indRow As Integer, rowTravelEnd As Integer, indTravel As Integer
Dim strTravelType As String, strPoint As String, varTravel As Variant
Dim varNational As Variant, strCity As String
Application.ScreenUpdating = False
varTravel = TravelAssociations() ' tableau des trajets par type, depart, arrivee
rowTravelEnd = Cells(Columns(colNational).Rows.Count, colTravel).End(xlUp).Row
If rowTravelEnd < Cells(Columns(colNational).Rows.Count, colNational).End(xlUp).Row Then
rowTravelEnd = Cells(Columns(colNational).Rows.Count, colNational).End(xlUp).Row
End If
strPoint = Cells(rowPoint, colPoint) ' Point du départ ou d'arrivée du voyage
For indRow = rowTravelStart To rowTravelEnd
strTravelType = Cells(indRow, colTravel)
strCity = vbNullString
For indTravel = LBound(varTravel) To UBound(varTravel)
If strTravelType = varTravel(indTravel)(indType) Then ' En région
If strPoint = pointDeparture Then
strCity = varTravel(indTravel)(indDeparture): Exit For
ElseIf strPoint = pointArrival Then
strCity = varTravel(indTravel)(indArrival): Exit For
End If
End If
Next
If strCity <> vbNullString Then ' La ville en région a été identifiée
Cells(indRow, colCity) = strCity
Else ' Applique la formule nationale s'il y a typeNational à partir de C6
varNational = Cells(indRow, colNational).Value
If VarType(varNational) = vbError Then ' En cas d'erreur de formule
varNational = vbNullString ' Absorbe l'erreur "#N/A" sans la corriger
End If
If varNational = typeNational Then ' Dans la France entière
Cells(indRow, colCity).Formula = strFormulaNational
Else
Cells(indRow, colCity) = vbNullString
End If
End If
Next
Application.ScreenUpdating = True
Debug.Print "Nombre de voyages trouvés : " & rowTravelEnd - rowTravelStart + 1
End Sub
' Table de chaque association : (type du voyage, ville de départ, ville d'arrivée)
' Si ces informations sont déjà sur la feuille, les lire et mettre à jour le tableau
Function TravelAssociations() As Variant
TravelAssociations = Array( _
Array("63c-1167", "ertein", "clermont ferrand"), _
Array("67c-2841", "cavaillon", "erstein"), _
Array("67c-1163", "clermont ferrand", "erstein"), _
Array("55c-1284", "cavaillon", "bar le duc"), _
Array("84c-1255", "bar le duc", "cavaillon"))
End Function
' Enlève les erreurs de formule dans un Range par ClearContents supprimant "#N/A"
' Attention la formule de la cellule générant "#N/A" est effacée !
Sub RemoveErrorNA(ByVal rngTargetWithErrorNA As Range)
Dim cellThis As Range, varCellValue As Variant
For Each cellThis In rngTargetWithErrorNA
varCellValue = cellThis.Value
If VarType(varCellValue) = vbError Then
If varCellValue = CVErr(xlErrNA) Then
cellThis.ClearContents
End If
End If
Next
End Sub |
