[VBA : Sous plage d'un Range

B-B -  
 B-B -
Bonjour,

Après de multiples recherche sur les forums, pas moyen de trouver la solution pour le débutant VBA que je suis : Comment définir un sous-Range d'un Range ? Par exemple si j'ai :

Set MyRange1 = Range("A:D")
Set My Range2 = Range("B:B")

J'aimerais faire ensuite un truc du genre :

Set MyRange1 = MyRange1 privé de MyRange2

Autrement dit obtenir le même résultat que : Set MyRange1 = Range("A:A,C:D")

Merci

7 réponses

eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 282
 
Bonsoir,

Une autre proposition avec une autre approche.
Excuse-moi michel, mais des questions comme j'aime il n'y en a pas beaucoup ;-)

La fonction accepte des sélections multiples sur range1 et range2, et accepte que range2 ne soit pas totalement inclus dans range1.

Sub test() 
    Dim range3 As Range 
    Set range3 = RangeDiff(Range("A:H,K:Z"), Range("B:B,D:E,H:M")) 
    MsgBox (range3.Address) 
End Sub 

Function RangeDiff(range1, range2) As Range 
    'crée un nouveau range avec les colonnes de range1 - les colonnes de range2 
    ' Ex: RangeDiff(Range("A:H,K:Z"), Range("B:B,D:E,H:M")) 
    ' retourne : range("A:A,C:C,F:G,N:Z") 
    ' (il doit rester au moins 1 colonne sinon erreur vba) 
    Dim cols() As Long
    Dim a As Range 
    Dim c As Long, i As Long 
    ReDim cols(0) 
    'ajout colonnes range 1 
    For Each a In range1.Areas 
        ReDim Preserve cols(UBound(cols) + a.Columns.Count) 
        For c = 1 To a.Columns.Count 
            i = i + 1 
            cols(i) = a.Columns(c).Column 
        Next c 
    Next a 
    'retrait colonnes range2 
    For Each a In range2.Areas 
        For c = 1 To a.Columns.Count 
            For i = 1 To UBound(cols) 
                If cols(i) = a.Columns(c).Column Then cols(i) = 0 
            Next i 
        Next c 
    Next a 
    'creation range3 
    Set RangeDiff = Worksheets(range1.Parent.Name).Columns(cols(1)) 
    For i = 2 To UBound(cols) 
        If cols(i) <> 0 Then Set RangeDiff = Union(RangeDiff, Worksheets(range1.Parent.Name).Columns(cols(i))) 
    Next i 
End Function 

eric
2
Mytå Messages postés 4246 Date d'inscription   Statut Contributeur Dernière intervention   954
 
Salut le forum

En gros tu veux le contraire de la fonction UNION

Pas évident comme problématique, mais on trouvera surement quelque chose...

Mytå
0
Patrice33740 Messages postés 8930 Statut Membre 1 782
 
Pas évident du tout, réaliser une fonction qui soustrait une plage continue d'une autre plage continue est assez simple mais créer un fonction EXCLUSION à plusieurs arguments me paraît bien plus ardu, mais je ne suis pas un pro du VBA.
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Bonjour à tous

ci dessous 1° jet brut de fonderie et sans garde-fou seulement pour les 26 premières colonnes (A-Z)et 1 seule exclue
je regarde (+tard) pour 256 colonnes

on sélectionne les colonnes A:F en excluant la colonne D

Sub test() 
scinder "a", "F", "D" 
End Sub 


Sub scinder(col_deb, col_fin, col_exc) 
Dim deb As Byte, fin As Byte, exc As Byte 
Dim tablo 
Dim espace As Range 

deb = Asc(UCase(col_deb)) 
fin = Asc(UCase(col_fin)) 
exc = Asc(UCase(col_exc)) 
ReDim tablo(0) 

For cptr = deb To fin 
    If cptr <> exc Then 
        tablo(cptr_t) = Chr(cptr) & ":" & Chr(cptr) 
        cptr_t = cptr_t + 1 
        ReDim Preserve tablo(cptr_t) 
    End If 
Next 
ReDim Preserve tablo(cptr_t - 1) 

Range(Join(tablo, ",")).Select 

End Sub 


0
B-B
 
Merci michel_m pour ce premier jet prometteur ;-)
cdlt.
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
bonjour,

Eriic, j'étais un peu étonné que tu ne sois pas déjà intervenu sur cet intéressant problème! et c'est vrai que ces casse-t^tes amusants sont rares...

bonne journée
amicalement

Michel
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
B-B
 
Merci à vous deux et heureux de savoir que ce genre de problème vous intéressent^^

Petit soucis avec la fonction d'eriic, par exemple le code suivant renvoie une erreur vba alors qu'aucun range n'est vide :


Sub test()
    Dim range3 As Range
    Set range3 = RangeDiff(Range("B:C"), Range("B:B"))
    MsgBox (range3.Address)
End Sub

0
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 282
 
Bonjour,

C'est vrai, je n'avais pas pensé qu'on pouvait aussi supprimer la 1ère colonne...
Sub test() 
    Dim range3 As Range 
    Set range3 = RangeDiff(Range("B:C"), Range("B:D")) 
    If Not range3 Is Nothing Then 
        MsgBox (range3.Address) 
    Else 
        MsgBox ("Range résultant = Nothing") 
    End If 
End Sub 

Function RangeDiff(range1, range2) As Range 
    'crée un nouveau range avec les colonnes de range1 - les colonnes de range2 
    ' Ex: RangeDiff(Range("A:H,K:Z"), Range("B:B,D:E,H:M")) 
    ' retourne : range("A:A,C:C,F:G,N:Z") 
    ' (il doit rester au moins 1 colonne sinon erreur vba) 
    Dim cols() As Long 
    Dim a As Range 
    Dim c As Long, i As Long, initOk As Boolean 
    ReDim cols(0) 
    'ajout colonnes range 1 
    For Each a In range1.Areas 
        ReDim Preserve cols(UBound(cols) + a.Columns.Count) 
        For c = 1 To a.Columns.Count 
            i = i + 1 
            cols(i) = a.Columns(c).Column 
        Next c 
    Next a 
    'retrait colonnes range2 
    For Each a In range2.Areas 
        For c = 1 To a.Columns.Count 
            For i = 1 To UBound(cols) 
                If cols(i) = a.Columns(c).Column Then cols(i) = 0 
            Next i 
        Next c 
    Next a 
    'creation range3 
    For i = 2 To UBound(cols) 
        If cols(i) <> 0 Then 
            If Not initOk Then 
                Set RangeDiff = Worksheets(range1.Parent.Name).Columns(cols(i)) 
                initOk = True 
            Else 
                Set RangeDiff = Union(RangeDiff, Worksheets(range1.Parent.Name).Columns(cols(i))) 
            End If 
        End If 
    Next i 
End Function


Au passage dans le sub test je montre comment traiter l'anomalie 'range vide'

eric
0
B-B
 
Merci eriic, It works well ;-)
0