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
|
Option Explicit
Sub RechercheAireCouveuse()
Dim RangAChercher As String
Dim I As Integer
Dim TitreLigne As Long
TitreLigne = 9
For I = 1 To 6
RangAChercher = "Rang " & I
With AireCouveuse(RangAChercher, TitreLigne)
MsgBox "Nom du rang : " & RangAChercher & Chr(10) & "Aire : " & .Address & Chr(10) & "Ligne : " & .Row & Chr(10) & "Colonne : " & .Column & Chr(10) & "Nb lignes : " & .Rows.Count & Chr(10) & "Nb colonnes : " & .Columns.Count
End With
Next I
End Sub
Function AireCouveuse(ByVal NomDuRang As String, ByVal LigneDeTitre As Long) As Range
Dim DerniereLigne As Long
Dim DerniereColonne As Long
Dim NbColonneDuRang As Long
Dim ColonneduRang As Long
Dim AireRecherche As Range
Dim CelluleRecherche As Range
With ActiveSheet
DerniereColonne = .Cells(LigneDeTitre, .Columns.Count).End(xlToLeft).Column
' Recherche du rang
'------------------
Set AireRecherche = .Range(.Cells(LigneDeTitre, 4), .Cells(LigneDeTitre, DerniereColonne))
ColonneduRang = 0
For Each CelluleRecherche In AireRecherche
If CelluleRecherche = NomDuRang Then
ColonneduRang = CelluleRecherche.Column
NbColonneDuRang = CelluleRecherche.MergeArea.Columns.Count
End If
Next CelluleRecherche
If ColonneduRang > 0 Then
DerniereLigne = .Cells(.Rows.Count, ColonneduRang).End(xlUp).Row
Set AireCouveuse = .Range(.Cells(LigneDeTitre, ColonneduRang), .Cells(DerniereLigne, ColonneduRang + NbColonneDuRang - 1))
End If
End With
End Function |
