Discussion :

[patricktoulon]

si je comprend bien
tu souhaiterait savoir si une fonction du genre maFeuilleUsedRange.aeras exist

Maintenant OUI!!!!
je ne l'ai pas fini c'est juste une ébauche !!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Type propert
     aeraByContigu(1 To 1000) As Range' te donnera l'areas dans l'ordre d'apparition dans le usedrange en fonction de son item dans les parenthèse(en object pas en string ) 
    aeraAllSUsedcells As Range 'te donnera la plage utilisé dans le usedrange sans les cellules vides 
    aeraByCuRegion(1 To 1000) As Range  'te donne le currentregion d'un aéra contiguës
     aerasCount As long                            'pas encore faite ' te donnera le nombre d'aéra 
 
End Type
Dim table As propert
Function maFeuilleUsedRange(splage As Range) As propert
    Dim RgAdresse, adresseFinal, dicoRange, Nbcellformula, nbe As Integer
    Nbcellformula = Application.CountIf(splage, splage.SpecialCells(xlCellTypeFormulas))
    Set dicoRange = CreateObject("Scripting.Dictionary")
    splage.SpecialCells(xlCellTypeConstants, 23).Select
    Set table.aeraAllSUsedcells = Selection
    RgAdresse = Split(Selection.Address, ",")
    For i = 0 To UBound(RgAdresse)
        Set region = Range(RgAdresse(i), RgAdresse(i)).CurrentRegion
        dicoexist = dicoRange.exists(region.Address) = True
        dicoRange(region.Address) = IIf(dicoexist, dicoRange(region.Address) & RgAdresse(i) & ",", "(" & RgAdresse(i) & ",")
    Next
    For Each elem In dicoRange
        dicoRange(elem) = Replace(dicoRange(elem) & ")", ",)", ")")
        nbe = nbe + 1
        Set table.aeraByContigu(nbe) = Range(dicoRange(elem))
        Set table.aeraByCuRegion(nbe) = Range(elem)
        alls = alls & dicoRange(elem)
    Next
     maFeuilleUsedRange = table
End Function

et pour tester

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub test3()
    'MsgBox maFeuilleUsedRange(ActiveSheet.UsedRange).aeraByContigu(1).Address'le 1 est l'index de l'aéra dans le aeracount pas fait encore pour le moment
    'MsgBox maFeuilleUsedRange(ActiveSheet.UsedRange).aeraByCuRegion(1).Address
    MsgBox maFeuilleUsedRange(ActiveSheet.UsedRange).aeraAllSUsedcells.Address
End Sub

je m'amuse comme un fou avec ce truc

If maFeuilleUsedRange.exist then msgbox "YOUPI!!!!!"

[eriiic]

Bonjour,

Ma participation.
Proches d'autres propositions, mais en limitant le nombre de boucles.
Sous forme de fonction qui retourne un Range des CurrentRegion, avec une option pour n'avoir que les plages visibles.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
    Dim pl As Range
    ' ex 1, tout
    Set pl = currentRegionAreas(ActiveSheet)
    pl.Select ' (éventuellement traiter l'erreur pl=Nothing)
    MsgBox "currentRegionAreas" & vbLf & pl.Address
 
    ' ex 2, visibles uniquement
    Set pl = currentRegionAreas(ActiveSheet, True)
    pl.Select
    MsgBox "currentRegionAreas, cellules visibles" & vbLf & pl.Address
End Sub
 
Function currentRegionAreas(sh As Worksheet, Optional visible As Boolean = False) As Range
    Dim pl As Range, ar As Range
    With ActiveSheet
        On Error Resume Next
        Set pl = Union(.UsedRange.SpecialCells(xlCellTypeConstants), .UsedRange.SpecialCells(xlCellTypeFormulas))
        On Error GoTo 0
        If pl Is Nothing Then Set currentRegionAreas = Nothing: Exit Function
        For Each ar In pl.Areas
            Set pl = Union(pl, pl.CurrentRegion)
        Next ar
        If visible Then Set pl = pl.SpecialCells(xlCellTypeVisible)
    End With
    Set currentRegionAreas = pl
End Function

Patrick, j'ai voulu tester ta dernière proposition pour voir le gain de temps mais je ne vois pas de différences avec cells.SpecialCells(xlCellTypeConstants) (?)

eric

[Philippe Tulliez]

Bonjour Patrick,

si je comprend bien
tu souhaiterait savoir si une fonction du genre maFeuilleUsedRange.aeras exist

Tu es super gentil mais comme tu utilises le pronom personnel "tu", je ne peux m'empêcher de répondre.
Je cherchais une fonction NATIVE car bien évidemment, je n'ai pas de soucis pour écrire une fonction personnalisée qui me renverrait ce type d'objet, résultat, nombre, etc. et accompagné de tous les contrôles (On error) nécessaire pour en faire une fonction fiable.

[Philippe Tulliez]

Bonjour Eric,

Patrick, j'ai voulu tester ta dernière proposition pour voir le gain de temps mais je ne vois pas de différences avec cells.SpecialCells(xlCellTypeConstants) (?)

Je suis d'accord avec toi, la méthode utilisée par Patrick est intéressante dans certaines situations mais il est bien évident que si nous avons des propriétés ou méthode natives en VBA, il faut privilégier celles-ci car elles sont plus courtes à écrire et certainement aussi rapide sinon plus.
D'où l'importance pour un développer VBA d'avoir une bonne maîtrise de l'application dans laquelle il développe pour éviter de réinventer la roue.

[patricktoulon]

salut erric
rNg.SpecialCells(xlCellTypeConstants,23)
ca n'est pas le 23 qui fait gagner du temps le 23 devrait normalement autoriser tout les formats ce n'est pas le cas bon j'avoue que la je n'est pas d'explications
ce qui fait la différence c'est entre une boucle(for each...next). sur un groupe de cellule et cells.SpecialCells(xlCellTypeConstants,23)qui te donne tout d'un coup

Philippe je ne cherche pas a réinventer la roue dans le cas de cette discutions la fonction n'existe pas

[davido84]

Bonjour,

j'ai pris un peu de temps pour tester les propositions de Philippe et de eriiic.
Deux remarques :

1) Vos propositions ramènent les cellules vides car elles prennent en compte le currentregion.
Aucun soucis sur le principe mais ce n'est pas ce que ramènent les items de la propriété Areas (ces items ne ramènent que les cellules ou plages de cellules non vides).
Donc dans un cas on est plus dans le UsedRange.Areas.CurrentRegion tandis que dans l'autre cas on est dans le UsedRange.Areas.Item(x).
Au moins comme cela on a les 2 possibilités en fonction de ce que l'on cherche à faire.

2) A partir du moment où l'on utilise la propriété SpecialCells couplée à la méthode Union il faut veiller à tester avant l'utilisation de Union que les constantes soient bien présentes sinon cela plante : si la plage à traiter ne comprend que que des constantes la partie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set pl = Union(.UsedRange.SpecialCells(xlCellTypeConstants), .UsedRange.SpecialCells(xlCellTypeFormulas))

plante (logique car Union demande au minimum 2 ranges valides et comme l'un des 2 est égal à Nothing Union ne peut fonctionner).
Donc si l'on sait à l'avance que la plage à traiter ne comporte que des constantes (ce que semble privilégier Philippe), pas de soucis. Par contre si la plage peut comporter des constantes et/ou des formules un test préalable s'impose.

je remarque d'ailleurs que Mercatog avait d'ailleurs prévu un test de ce type dans sa proposition (bien vu).

A+
David

[patricktoulon]

salut Davido

c'est justeent le probleme que j'ai pour finaliser ma fonction

j'ai essayer le test avec application.countif , is nothing
et comme a 'inverse de Philippe je ne veux pas utiliser de "on error"

car je part du principe que :avant de taper dans le mur et utiliser un " on error " puis bifurquer
il serait plus judicieux utiliser un if/else/end if : une erreur pouvant engendrer même le blocage d'Excel même avec un " on error ...."

[Philippe Tulliez]

Bonjour Patrick,

car je part du principe que :avant de taper dans le mur et utiliser un " on error " puis bifurquer
il serait plus judicieux utiliser un if/else/end if : une erreur pouvant engendrer même le blocage d'Excel même avec un " on error ...."

Le ON ERROR a été créé pour cela.
La boîte de dialogue Atteindre/Cellules... qui est la boîte utilisant la propriété SpecialCells se met en erreur si tu sélectionnes Formules et que la plage concernée ne contient pas de formule.
Il faut donc en VBA faire précéder l'instruction objectRange.SpecialCells(xlCellTypeFormulas) par un On Error Resume Next pour anticiper le problème et réagir en conséquence.
C'est le même raisonnement lorsque l'on renomme des feuilles (pour éviter les homonymes), des tableaux croisés dynamique, créer un répertoire, etc.
Il est plus rapide d'utiliser le gestionnaire d'erreurs que d'intégrer une structure décisionnelle (If, Select ..Case) à l'intérieur d'une structure répétitive (boucle) ou alors je n'ai rien compris à la programmation.
Dans l'extrait de la procédure ci-dessous, je ne "bifurque pas", je "passe au-dessus".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 With shtDb.UsedRange
  Set rngUsed = .SpecialCells(xlCellTypeConstants)
  On Error Resume Next
  Set rngUsed = Union(rngUsed, .SpecialCells(xlCellTypeFormulas))
  On Error GoTo 0
 End With

[davido84]

Bonjour Patrick,

Concernant l'utilisation du On error à partir du moment où tu sais exactement où cela peut planter l'utilisation du On error resume next ne pose pas de problème particulier si tu contrôles le déroulement de ta macro. Un truc du genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
On Error Resume Next
Set PlC = Usplg.SpecialCells(xlCellTypeConstants)
Set PlF = Usplg.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
 
If PlC Is Nothing And PlF Is Nothing Then Exit Sub
 
If PlC Is Nothing Or PlF Is Nothing Then
  Set Pl = IIf(PlC Is Nothing, PlF, PlC)
Else
  Set Pl = Union(PlC, PlF)
End If

ne va pas te faire planter Excel.

Mais bon si je trouve quelque chose d'autre sans rentrer dans la production d'une usine à gaz je te fais signe.
A+
David

[patricktoulon]

re
Bon je ne trouve toujours pas comment me passer de "on error" tant pis
j'ai modifié le fonctionnement de la fonction
la fonction ramène un long maintenant ,ce long représente le aeracount ( contigues/currentregion)

Le"maFeuilleUsedRange est devenu un object static de type propert

les propriété de cet object(propert)sont renseignées dans la fonction
comme ca il n'est pas nécessaire de faire tourner la fonction a chaque fois qe l'on a besoin des régions( métrisant mal le callback)j'ai opté pour cette solution
il faut donc demander le aeracount pour avoir la totale
et finalement c'est normal (comment boucler sur le aeracount si on en connais pas le nombre )
voila la fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
Type propert
    aeraByContigu(1 To 1000) As Range
    aeraAllSUsedcells As Range
    aeraByCuRegion(1 To 1000) As Range
End Type
Public maFeuilleUsedRange As propert
Function maFeuilleaeracount(Optional splage As Range) As Long
    Dim RgAdresse, dicoRange, nbe As Integer, F As Range, C As Range, i As Long, alls As String
    Dim OK As Boolean, plage As Range, region As Range, dicoexist As Boolean, elem, rngUsed
    OK = splage Is Nothing = False: Set plage = IIf(OK, splage, ActiveSheet.UsedRange)
        With plage
        Set rngUsed = .SpecialCells(xlCellTypeConstants)
        On Error Resume Next
        Set rngUsed = Union(rngUsed, .SpecialCells(xlCellTypeFormulas))
        On Error GoTo 0
    End With
 
    Set plage = rngUsed
    Set dicoRange = CreateObject("Scripting.Dictionary")
    Set maFeuilleUsedRange.aeraAllSUsedcells = plage
    RgAdresse = Split(plage.Address, ",")
    For i = 0 To UBound(RgAdresse)
        Set region = Range(RgAdresse(i), RgAdresse(i)).CurrentRegion
        dicoexist = dicoRange.exists(region.Address) = True
        dicoRange(region.Address) = IIf(dicoexist, dicoRange(region.Address) & RgAdresse(i) & ",", "(" & RgAdresse(i) & ",")
    Next
    For Each elem In dicoRange
        dicoRange(elem) = Replace(dicoRange(elem) & ")", ",)", ")")
        nbe = nbe + 1
        Set maFeuilleUsedRange.aeraByContigu(nbe) = Range(dicoRange(elem))
        Set maFeuilleUsedRange.aeraByCuRegion(nbe) = Range(elem)
        alls = alls & dicoRange(elem)
    Next
    maFeuilleaeracount = dicoRange.count
End Function

et voila quelques exemple de comment on peut s'en servir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub testprime0()
    Dim nBcount As Long
    nBcount = maFeuilleaeracount(Sheets(2).UsedRange)    'on precise la feuille sur la quelle on veut travailler
    If nBcount > 0 Then MsgBox maFeuilleUsedRange.aeraByContigu(1).Address    'te donne la premiere region contigues exacte
    'OU
    'te donne la premiere currentregion corespondant a la  premiere region contigue :::et c'est pareil pour toutes les autre regions
    'If nBcount > 0 Then MsgBox maFeuilleUsedRange.aeraByCuRegion(1).Address
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub testprime1()
    Dim nBcount As Long
    nBcount = maFeuilleaeracount    ' sans precision la feuille pris en compte est la feuille active
    If nBcount > 0 Then MsgBox maFeuilleUsedRange.aeraByContigu(1).Address    'te donne la 3 eme region contigues exacte si nBcount n'est pas inferieur
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub testprime2()
    Dim nBcount As Long
    nBcount = maFeuilleaeracount(Sheets(2).UsedRange)    'on precise la feuille sur la quelle on veut travailler
    If nBcount > 0 Then MsgBox maFeuilleUsedRange.aeraByContigu(nBcount).Address    'te donne la derniere region contigues exacte
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub testprime3()
'boucle sur toutes les regions contigues
    Dim nBcount As Long, i As Long
    nBcount = maFeuilleaeracount    ' sans precision la feuille pris en compte est la feuille active
    If nBcount > 0 Then
        For i = 1 To nBcount
            MsgBox maFeuilleUsedRange.aeraByContigu(i).Address    'te donne la i eme  region contigues exacte
        Next
    End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub testprime4()
'boucle sur toutes les regions contigues
    Dim nBcount As Long, i As Long
    nBcount = maFeuilleaeracount    ' sans precision la feuille pris en compte est la feuille active
    If nBcount > 0 Then
        For i = 1 To nBcount
            MsgBox maFeuilleUsedRange.aeraByContigu(i).Address    'te donne la i eme  region contigues exacte
        Next
    End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub testprime5()
    Dim nBcount As Long
    nBcount = maFeuilleaeracount(Sheets(2).UsedRange)    'on precise la feuille sur la quelle on veut travailler
    If nBcount > 0 Then MsgBox maFeuilleUsedRange.aeraAllSUsedcells.Address    'te donne la plage exacte de cellule utilisées
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub testprime6()
    Dim nBcount As Long
    nBcount = maFeuilleaeracount(Sheets(2).UsedRange)    'on precise la feuille sur la quelle on veut travailler
    MsgBox maFeuilleUsedRange.aeraByContigu(1).Interior.Color    'te donne la couleurde la  plage contigue
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub testprime7()
'boucle sur toutes les regions contigues
    Dim nBcount As Long, cel As Range
    nBcount = maFeuilleaeracount    ' sans precision la feuille pris en compte est la feuille active
    If nBcount > 0 Then
        For Each cel In maFeuilleUsedRange.aeraByContigu(1).Cells
            MsgBox cel    'Affche la veur de chaque  cel dans un message
        Next
    End If
End Sub

Ps: Merci a Philipe de m'avoir donné un os a ronger

[patricktoulon]

re

Non de dieu!!! j'ai trouvé (mais bon sang mais c'est bien sur )

on peut s'en passer du "on error"

avec tout simplement la fonction HasFormula

en fait je fait le test sur une cellule dont je suis sur qu'il y a une formule
la fonction me retourne (vraie/true)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

debug.print cells(10,9).HasFormula

je fait le test sur une plage de cellules ou il n'y a pas de formule
la fonction me retourne faux (false)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

debug.print range("A1:B8").HasFormula

je fait le test sur une plage ou je suis sur qu'il y a des formules
et la la fonction me retourne "NULL"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

debug.print range("f23:H30).HasFormula

et ben voila!!!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if plage.HASFORMULA="NULL" then .....

et le "on error" hop !! dehors

[Philippe Tulliez]

Bonjour Patrick,
Tu es le Lucky Luck de la programmation ce qui t'empêche je crois le temps de la réflexion et surtout de tests plus poussés.
En effet, tu passes au delà du On Error mais ton test n'est pas suffisant
La propriété HasFormula de l'objet Range renvoie VRAI si la cellule ou toutes les cellules de la plage contiennent des formules et FAUX si celles-ci contiennent des constantes. NULL est renvoyé si dans la plage de cellules il y a à la fois des formules et des constantes

[patricktoulon]

Tu es le Lucky Luck de la programmation

disons que je me décourage pas facilement

Mais tu a un peu raison j'essais de l'adapter mais avec la propriété null ca me renvoie utilisation incorrecte de la propriété

hors dans le debug.print j'ai bien un string du moins je crois non?????

sinon comment convertir cette donnée en string ??????

j'ai peut être chanter un peu vite le chant de la victoire
je cherche et je trouverais

[patricktoulon]

re
Maintenant je peut chanter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 With plage
        Set rngUsed = .SpecialCells(xlCellTypeConstants)
        Debug.Print plage.HasFormula
 
         If IsNull(plage.HasFormula) Or plage.HasFormula = True Then Set rngUsed = Union(rngUsed, .SpecialCells(xlCellTypeFormulas))
        End With

PS : on s'est croisé essai mon code tu verra qu'il fonctionne je viens de l'intégré dans ma fonction et c'est Nickel elle n'est pas prise en defaut

[Philippe Tulliez]

Bonjour Patrcik,

disons que je me décourage pas facilement

Moi non plus mais programmer demande du temps et beaucoup de patience et nous ne sommes pas à l'abri de bugs et d'erreur de conception mais je crois que prendre 30 minutes de plus avant de publier permet de diffuser des procédures "bug free" et surtout de ne pas conclure trop rapidement.
En tout les cas c'est mon avis.

Ainsi si tu tapes deux constantes dans la plage A13:B13 et une formule respectivement en C13 et D13
Test des cellules

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub TestHasFormula()
 Debug.Print Range("A13").HasFormula ' Contient une constante
 Debug.Print Range("A13:B13").HasFormula ' Contient des constantes
 Debug.Print Range("C13").HasFormula ' Contient une formule
 Debug.Print Range("C13:D13").HasFormula  ' Contient des formules
 Debug.Print Range("A13:D13").HasFormula ' contient des formules et des constantes
End Sub

Renverra
Faux
Faux
Vrai
Vrai
Null

[patricktoulon]

j'ai fait exactement ce que tu a dis
A13,B13 constante
C13,D13 formules
et j'ai mis mes deux lignes de codes dans une fonction renvoyant true ou false comme ca c'est plus clair
fonction et sub

Lance TestHasFormula

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub TestHasFormula()
 Debug.Print formuleINcell(Range("A13")) ' Contient une constante
 Debug.Print formuleINcell(Range("A13:B13")) ' Contient des constantes
 Debug.Print formuleINcell(Range("C13")) ' Contient une formule
 Debug.Print formuleINcell(Range("C13:D13"))  ' Contient des formules
 Debug.Print formuleINcell(Range("A13:D13")) ' contient des formules et des constantes
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Function formuleINcell(plage)
 With plage
 If IsNull(plage.HasFormula) Or plage.HasFormula = True Then
 formuleINcell = True
 Else
 formuleINcell = False
 End If
 End With
End Function

le résultat dans le debug

Faux
Faux
Vrai
Vrai
Vrai

[eriiic]

Re,

Vos propositions ramènent les cellules vides car elles prennent en compte le currentregion.

Pour ma part c'est voulu pour coller plus à la philosophie CurrenRegion, objet de la question.
J'avais mis une option pour choisir avec ou sans, que j'ai supprimée. Ca ne paraissait pas pertinent dans ce cadre.
Dans ma proposition il suffit de supprimer la boucle for each... next pour n'avoir plus que les cellules remplies.

Et pour le traitement d'erreur, ne faisant pas d'allergie au On Error je ne me suis pas retenu ;-)
eric

[Philippe Tulliez]

Bonsoir Patrick,

et j'ai mis mes deux lignes de codes dans une fonction renvoyant true ou false comme ca c'est plus clair

Et bien voilà, maintenant c'est parfait, on sait que si la fonction renvoie VRAI, il y a au moins une formule.

[patricktoulon]

re
j'avais donc raison, on peut bien se passer de " on error"

en plus pour preuve je l'ai intégré a mafonction feuillusedrange et elle est plus rapide encore

ca veut bien dire que l'incidence même si l'erreur était gérée par le "on error " n'était pas null

ca marche au poil

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
Type propert
    aeraByContigu(1 To 1000) As Range
    aeraAllSUsedcells As Range
    aeraByCuRegion(1 To 1000) As Range
End Type
Public maFeuilleUsedRange As propert
Function maFeuilleaeracount(Optional splage As Range) As Long
    Dim RgAdresse, dicoRange, nbe As Integer, F As Range, C As Range, i As Long, alls As String
    Dim OK As Boolean, plage As Range, region As Range, dicoexist As Boolean, elem, rngUsed, Nbcellformula As Boolean
    OK = splage Is Nothing = False: Set plage = IIf(OK, splage, ActiveSheet.UsedRange)
        With plage
        Set rngUsed = .SpecialCells(xlCellTypeConstants)
           If IsNull(plage.HasFormula) Or plage.HasFormula = True Then Set rngUsed = Union(rngUsed, .SpecialCells(xlCellTypeFormulas))
        End With
 
    Set plage = rngUsed
    Set dicoRange = CreateObject("Scripting.Dictionary")
    Set maFeuilleUsedRange.aeraAllSUsedcells = plage
    RgAdresse = Split(plage.Address, ",")
    For i = 0 To UBound(RgAdresse)
        Set region = Range(RgAdresse(i), RgAdresse(i)).CurrentRegion
        dicoexist = dicoRange.exists(region.Address) = True
        dicoRange(region.Address) = IIf(dicoexist, dicoRange(region.Address) & RgAdresse(i) & ",", "(" & RgAdresse(i) & ",")
    Next
    For Each elem In dicoRange
        dicoRange(elem) = Replace(dicoRange(elem) & ")", ",)", ")")
        nbe = nbe + 1
        Set maFeuilleUsedRange.aeraByContigu(nbe) = Range(dicoRange(elem))
        Set maFeuilleUsedRange.aeraByCuRegion(nbe) = Range(elem)
        alls = alls & dicoRange(elem)
    Next
    maFeuilleaeracount = dicoRange.count
End Function

divers tests

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub testprime0()
    Dim nBcount As Long
    nBcount = maFeuilleaeracount(Sheets(2).UsedRange)    'on precise la feuille sur la quelle on veut travailler
    If nBcount > 0 Then MsgBox maFeuilleUsedRange.aeraByContigu(1).Address    'te donne la premiere region contigues exacte
    'OU
    'te donne la premiere currentregion corespondant a la  premiere region contigue :::et c'est pareil pour toutes les autre regions
    'If nBcount > 0 Then MsgBox maFeuilleUsedRange.aeraByCuRegion(1).Address
End Sub
Sub testprime1()
    Dim nBcount As Long
    nBcount = maFeuilleaeracount    ' sans precision la feuille pris en compte est la feuille active
    If nBcount > 0 Then MsgBox maFeuilleUsedRange.aeraByContigu(1).Address    'te donne la 3 eme region contigues exacte si nBcount n'est pas inferieur
End Sub
Sub testprime2()
    Dim nBcount As Long
    nBcount = maFeuilleaeracount(Sheets(2).UsedRange)    'on precise la feuille sur la quelle on veut travailler
    If nBcount > 0 Then MsgBox maFeuilleUsedRange.aeraByContigu(nBcount).Address    'te donne la derniere region contigues exacte
End Sub
Sub testprime3()
'boucle sur toutes les regions contigues
    Dim nBcount As Long, i As Long
    nBcount = maFeuilleaeracount    ' sans precision la feuille pris en compte est la feuille active
    If nBcount > 0 Then
        For i = 1 To nBcount
            MsgBox maFeuilleUsedRange.aeraByContigu(i).Address    'te donne la i eme  region contigues exacte
        Next
    End If
End Sub
Sub testprime4()
'boucle sur toutes les regions contigues
    Dim nBcount As Long, i As Long
    nBcount = maFeuilleaeracount    ' sans precision la feuille pris en compte est la feuille active
    If nBcount > 0 Then
        For i = 1 To nBcount
            MsgBox maFeuilleUsedRange.aeraByContigu(i).Address    'te donne la i eme  region contigues exacte
        Next
    End If
End Sub
Sub testprime5()
    Dim nBcount As Long
    nBcount = maFeuilleaeracount(Sheets(2).UsedRange)    'on precise la feuille sur la quelle on veut travailler
    If nBcount > 0 Then MsgBox maFeuilleUsedRange.aeraAllSUsedcells.Address    'te donne la plage exacte de cellule utilisées
End Sub
Sub testprime6()
    Dim nBcount As Long
    nBcount = maFeuilleaeracount(Sheets(2).UsedRange)    'on precise la feuille sur la quelle on veut travailler
    MsgBox maFeuilleUsedRange.aeraByContigu(1).Interior.Color    'te donne la couleurde la  plage contigue
End Sub
Sub testprime7()
'boucle sur toutes les regions contigues
    Dim nBcount As Long, cel As Range
    nBcount = maFeuilleaeracount    ' sans precision la feuille pris en compte est la feuille active
    If nBcount > 0 Then
        For Each cel In maFeuilleUsedRange.aeraByContigu(1).Cells
            MsgBox cel    'Affche la veur de chaque  cel dans un message
        Next
    End If
End Sub

[eriiic]

Re,

Avec un peu (beaucoup :-) ) de retard :

salut erric
rNg.SpecialCells(xlCellTypeConstants,23)
ca n'est pas le 23 qui fait gagner du temps le 23 devrait normalement autoriser tout les formats ce n'est pas le cas bon j'avoue que la je n'est pas d'explications

Je ne parlais pas du 23, mais plus globalement l'apport du dictionary si il y a beaucoup de plages.
Mais au sujet du 23 je crois que tu as raté ça : http://www.developpez.net/forums/d15...e/#post8188805

eric