VBA - Range Exclusion - Exclure un Range d'un autre Range V5

[patricktoulon]

@bsalv
je crois que tu n'a pas compris là ou je veux en venir
j'ai choisi deux petites plages pour que ça vous soit plus evident
le timer on s'en fou pour le moment
et vous etes rallenti parce que vous faite des unions cell by cell
je n'utilise pas cette methode perso sauf pour la restitution qui n'est que du stokage

je vous donne un indice
dans mon exemple quel est le range à garder pour l'examen ?

 

[bsalv]

@Dudu2 , avez-vous amélioré votre macro ?

 

[bsalv]

@patricktoulon ,
on parle de 2 choses différentes,

* normallement on a 2 plages assez simple et petit comme le 2ième image de #30, la différence de temps est nulle, c'est chez moi, c'était 0.07s, le temps pour ajouter une nouvelle feuille et le supprimer après.

* puis image 1 de #30. ce sont 2 plages plus grand mais avec un "area", là, on est encore quasi dans le mêmes temps.

* #32, les plages complexes de dudu2 avec 200.000 (!) cellules (biensûr, c'est exagéré et en réalité extremement rare), mais la méthode normalle n'existe plus ...

Donc, je ne sais pas/plus pourquoi @Dudu2 a commencé ce topic, mais je pense que c'était pour des situatons où le temps d'exécution devient trop grand, le dernier 1% des cas.

 

[Dudu2]

Salut la compagnie,
Oui j'ai corrigé un bug. Mais les Ranges de test sont favorables à la méthode Map Range To Table car il ne sont pas éloignés aux extrêmes colonnes et surtout lignes. C'est pratiquement toujours le cas mais il faut que je prévoie les 2 méthodes selon la dimension de couverture du Range Réservoir. Car au-delà de 10**9 c'est Mémoire insuffisante. Et si tu choisis Worksheets(1).Cells ça fait plus de 17 milliard de cellules.
Je vais envoyer un fichier qui donne 2 possibilités: Ranges proches et Ranges éloignés.

 

[patricktoulon]

re
si @Dudu2 veux bien expliquer le principe du Table map sans passer par des passerelles (encore une fois)
peut être dans une simple sub avec 2 plages me suffirait
ca doit pas être compliqué de faire ça non ?
j'apprecierais beaucoup

 

[Dudu2]

Salut @patricktoulon,
Pour l'instant je cogite et j'ai un peu de mal, mais ça vient !

Le principe du Map Range To Table consiste à:
- Déterminer la 1ère et dernière ligne et la 1ère et dernière colonne du Range (toutes ses Areas)
- D'utiliser un tableau de booléens dont les 2 dimensions sont celles du Range global (qui couvre le tout Range) et dont chaque item représente une cellule. True si la cellule appartient au Range False sinon. Le Tableau de booléens "mappe" le Range global. Et c'est là sa faiblesse si des Areas sont aux 4 coins de la feuille.

Pour l'exclusion on passe à False les items du tableau qui correspondent au Range à Exclure.

Ensuite on "mappe" le tableau sur un Range, mais pas / plus item par item (cellule par cellule) mais en recherchant des zones contigües dans le tableau représentant dont des Areas.

En fait c'est comme la solution de @bsalv, mais au lieu de mettre des "x" dans des cellules, j'utilise un tableau mémoire qui représente ces cellules.

 

[patricktoulon]

bon c'est presque clair merci @Dudu2

j'avais a peu pris compris ça
ce qui me g^ne et visiblement toi aussi c'est la reconvertion du tableau en area de range
pour le coup j'ai cherché dans mes vieux trucs
et j'ai trouvé des vielles fonctions avec union et intersect mais globale
par exemple ma fonction pour trouver les area à exclure

Sub tesz()
MsgBox GetRangeToExclude(Range("D3:J9;E1:E15;B7:E7;G1:G5")).Address
End Sub


Function GetRangeToExclude(rng As Range) As Range
'patricktoulon Developpez.com 18/06/2015
'fonction pour déterminer les plages  qui se croisent dans des areas
'le rng est une plage avec des areas
    Dim RngEx As Range, A&, B&, Ri As Range
    For A = 1 To rng.Areas.Count
        For B = 1 To rng.Areas.Count
            If B <> A Then
                Set Ri = Intersect(rng.Areas(A), rng.Areas(B))
                If Not Ri Is Nothing Then
                    If RngEx Is Nothing Then Set RngEx = Ri Else Set RngEx = Union(RngEx, Ri)
                End If
            End If
        Next
    Next
    Set GetRangeToExclude = RngEx
End Function

 

[patricktoulon]

re
j'ai adapté mes vieux truc
on a deux choix
1°soit les areas sans intersection etant dans le perimetre de l'areas(1)d'un range(pour corresponfre a ce que vous cherchez à faire)
2°soit tout sauf les intersections
j'ai mis les commentaires en inglouwish pour faire plaisir à dudu

'******************************************************************************************************************************************************
'    ___      _     _______  __      _    ____  _   _  _______  ___      _   _    _    ___      _     _.
'   //  \\   /\\      //    // \\   //   //    //  //    //    //  \\   //  //   //   //  \\   //|   //
'  //___//  //__\    //    //__//  //   //    //__||    //    //   //  //  //   //   //   //  // |  //
' //       //   \\  //    //  \\  //   //    //  \\    //    //   //  //  //   //   //   //  //  | //
'//       //    // //    //   // //   //___ //    \\  //     \\__//  //__//   //___ \\__//  //   |//
'******************************************************************************************************************************************************
Option Explicit
Sub testx()
    Dim R(1 To 4) As Range
    Dim texte As String
    Dim rng As Range
    Dim RangeExcluded As Range
    Dim KeepRange As Range

    Cells.Interior.Color = xlNone

    'for the example 4 ranges which intersect somewhere
    Set R(1) = [D3:J9]
    Set R(2) = [E1:E15]
    Set R(3) = [B7:E7]
    Set R(4) = [G1:G5]

    'for the demo I put the ranges in color
    R(1).Interior.Color = RGB(0, 200, 255)
    R(2).Interior.Color = RGB(0, 255, 200)
    R(3).Interior.Color = RGB(255, 200, 0)
    R(4).Interior.Color = RGB(200, 255, 0)

    'we group them all together with union function
    Set rng = Union(R(1), R(2), R(3), R(4))

    'I will find the ranges to be excluded with the GetRangeToExclude function
    'by having the range excluded you can even use it in another context
    Set RangeExcluded = GetRangeToExclude(rng)

    'we keep the cells which do not intersect with others and which remain in the surface of the area(1)
    Set KeepRange = GetKeepRange(rng, RangeExcluded, R(1))    'on ne garde que c'elles qui sont dans la surface de r(1) sauf les intersections

    'we keep the cells which do not intersect with others for all areas
    'Set KeepRange = GetKeepRange(rng, RangeExcluded) 'on ne garde tout sauf les intersections


    texte = "The ranges tested are : " & rng.Address(0, 0) & vbCrLf
    texte = texte & "The ranges exclued are : " & RangeExcluded.Address(0, 0) & vbCrLf
    texte = texte & "The guarded ranges are : " & KeepRange.Address(0, 0)
    KeepRange.Select
    MsgBox texte
End Sub

Sub tesz()
    MsgBox GetRangeToExclude(Range("D3:J9;E1:E15;B7:E7;G1:G5")).Address
End Sub
Function GetRangeToExclude(rng As Range) As Range
'patricktoulon Developpez.com 18/06/2015
'fonction pour déterminer les plages  qui se croisent dans un area ou un range
'le rng est une plage avec des areas
    Dim RngEx As Range, A&, B&, Ri As Range
    For A = 1 To rng.Areas.Count
        For B = 1 To rng.Areas.Count
            If B <> A Then
                Set Ri = Intersect(rng.Areas(A), rng.Areas(B))
                If Not Ri Is Nothing Then
                    If RngEx Is Nothing Then Set RngEx = Ri Else Set RngEx = Union(RngEx, Ri)
                End If
            End If
        Next
    Next
    Set GetRangeToExclude = RngEx
End Function

Function GetKeepRange(R As Range, RngEx As Range, Optional RngRef As Range = Nothing) As Range
'patricktoulon Developpez.com 18/06/2015
'récupération des plages sans les intersections
    Dim RngF As Range, area, cel As Range, X As Boolean
    If Not RngRef Is Nothing Then Set R = R.Areas(1)
    For Each cel In R.Cells
        X = True
        For Each area In RngEx.Areas
            If Not Intersect(area, cel) Is Nothing Then X = False: Exit For
        Next
        If X Then If RngF Is Nothing Then Set RngF = cel Else Set RngF = Union(RngF, cel)
    Next
    Set GetKeepRange = RngF
End Function

 

[Dudu2]

De mon coté, j'ai limité le nombre de cellules du Range Réservoir global à 10 millions de cellules pour appliquer la méthode Map Range To Table. Ça doit correspondre à 99% des cas pratiques.

Si ça dépasse, j'utilise le méthode traditionnelle améliorée.
Je pense que dans ce cas il faudrait utiliser la méthode de @bsalv, si on accepte l'idée d'ajouter une feuille pour faire cette manip.

 

[patricktoulon]

juste une question
ton reservoir global est il contigue

 

[Dudu2]

Oui, il est contigüe et c'est ça sa faiblesse.
Si tu as un Range de 2 cellules [A1,XFD1048576], le Range Global devrait faire 17.179.869.184 cellules.
C'est pour ça que la représentation en table a ses limites que n'a pas la représentation en feuille de l'approche de @bsalv.

Mais encore une fois, il faut accepter de passer par une feuille temporaire, ce qui peut poser problème si le classeur est protégé ou en lecture seule.

Alors j'ai réfléchi à le scinder par Area. Faudrait voir. Encore qu'une seule Area peut avoir des dimensions très grandes non compatible avec son mapping en table.

 

[Dudu2]

Ou alors, il faudrait mapper le Range en table différemment.
Avoir un table à 1 dimension de Doubles qui représente un numéro de cellule (n° ligne * 10**7 + n° colonne).
Mais ça risque de générer pas mal de parcours et de décalage en table lors du mapping des Areas du Range.

 

[Dudu2]

Ou peut-être mapper sur un Type.

Type Ligne
    NoLigne As Long
    TabNosColonnes() As Integer
End Type

Dim L() As Ligne

Je vais essayer ça.

 

[patricktoulon]

re
non moi j'ai eu une idée qui est parti tres vite car je traite plusieurs sujet en même temps
mais !!
voilà mon idéé
et je vais même plus loin
on a des areas(1,2,3,4,etc,etc)
1°on dimentionne un tableau de A1 à la derniere cellules basse et droite des areas
on a donc une variable tableau (1 to x, 1 to y)
2]dans une boucle on boucle sur tout les areas(pas les cellules)je dis bien les areas
dans cette boucle(on l'a vu dans un exercice précédent) on redim des variable tableau non pas de 1 a x et 1 à y mais avec leur index réels
exemple j'ai un area "F3:j15" ma variable sera t(3 to 15,6 to 10)
on ne met rien dans ces variables tableaux
a la fin de cette boucle on a donc notre map des areas en tableau
il suffit de test les index lbound et ubound pour savoir si il se croise en eux
si il se croisent pas ben false sinon true
on se retrouve avec une variable tableau mesurant pareil que de A1 a la last cell des areas
parti de là tu a ton map en variable tableau
il suffit de reconstruire les areas avec le bouboul de la valeur des items
cette partie j'ignore comment tu fait

en faisant comme ça on a pas de soucis d'index

 

[bsalv]

Mais encore une fois, il faut accepter de passer par une feuille temporaire, ce qui peut poser problème si le classeur est protégé ou en lecture seule.

sinon, on utilise un workbook au lieu d'une feuille ...