Fonction pour concaténer des cellules d'un range disjoint

Bonjour,

J'ai besoin de lancer en VBA une formule mathématique de la bibliothèque standard ("WorksheetFunction") du type Min, Max ou régression linéaire sur un range venant d'une fonction de tri.

Or je m'aperçois que ce type de function ne prend en compte que les Range constitués d'une seule Area, et au mieux renvoient une valeur erronée correspondant au calcul sur la première Area, et au pire comme la fonction Correl, un erreur.

Je voudrais donc trouver un moyen de concatener mon Range, dans une feuliie temporaire spécifique, le temps de lancer mon calclu dessus.

J'ai construit la fonction suivante pour expliciter mon besoin:

• a) Je crée un range de test , constitué de 3 parties disjointes que je regroupe par une Union.
• b) je procède à un tri, en utilisant un Array, que je redimensionne grace à un Range.Count de mon range exemple
• c) je procède à la recopie de l4Array dans un Range sur une feuille Arrivée.

Ce serait trop beau pour que cela aie marché du premier coup, et à la copie finale de mon Range (préalablement nettoyé sur la feuille d'arrivée par un appel à ClearContents) j'ai une erreur.

Voici le code de ma fonction:

Function CopieConcatene() As Boolean
    Dim wsDepart, wsArrivee As Worksheet
    Dim plage1Rng, plage2Rng, plage3Rng, departRng, arrayCell As Range
    Dim MonAr() As Variant
    Dim n As Long, i As Long

On Error GoTo TraitementErreur
    '~~> initialisation des feuilles pour le test
    Set wsDepart = Worksheets("Départ")
    Set wsArrivee = Worksheets("Arrivée")

    '~~> construction du range de test contenant les zones disjointes
    wsDepart.Activate
    Set plage1Rng = wsDepart.Range(Cells(1, 1), Cells(2, 1))
    Set plage2Rng = wsDepart.Range(Cells(5, 1), Cells(6, 1))
    Set plage3Rng = wsDepart.Cells(8, 1)

    Set departRng = Union(plage1Rng, plage2Rng, plage3Rng)

    '~~> remplissage de l'array intermédiaire pour récuperer toutes les valeurs du Range contenant les zones disjointes
    Set departRng = Union(plage1Rng, plage2Rng, plage3Rng)

    n = departRng.Cells.Count

    '~~> Redimensionnement de l'array qui va stocker les valeur du range disjoint avant la copie dans la feuille d'arrivée
    ReDim MonAr(1 To n)

    n = 1

    '~~> Stocke les valeurs du range discontinu dans l'array
    For Each arrayCell In departRng.Cells
        MonAr(n) = arrayCell.Value
        n = n + 1
        Next arrayCell
    Debug.Print "n=" & n
    '~~> Copie de l'array sur la feuille Arrivée:

    '~~> Copie sur une ligne de l'array
    'wsArrivee.Cells(1, 1).Resize(1, UBound(MonAr)).Value = MonAr

    '~~> Copie sur une colonne de l'array
    'wsArrivee.Activate
    wsArrivee.Cells(1, 1).Resize(254, 1).ClearContents
    wsArrivee.Cells(1, 1).Resize(UBound(MonAr), 1).Value = Application.WorksheetFunction.Transpose(MonAr)

    CopieConcatene = True
    wsDepart.Activate
    Exit Function
TraitementErreur:
Debug.Print vbLf & Err.Number & vbLf & Err.Description
CopieConcatene = False
End Function

Je soupconne que je gère mal, l'activation des feuilles ou je me trouve (disons Départ) et celle ou se fait la copie (Arrivée), mais j'ai essayé plusieurs manips avec Activate mais cela ne marche pas.

Un coup d'éclairage d'un sachant me ferait le plus grand bien -:)

Merci d'avance pour toute aide.

StefToulouse

Bonjour,

une fonction (personnalisée) utilisée à partir d'excel, ne peut pas modifier de la cellule (les cellule en cas de formule matricielle) autre(s) que celle(s) dans la(les)quelle(s) se trouve(nt) la formule. Si tu essaies de le faire la fonction se mettra en erreur.

Merci, h2so4,

En faisant de la biblio sur le forum je viens de le comprendre.

Je vais essayer de travailler directement avec les arrays au lieu de travailler avec les range.

Merci pour ta réponse,

StefToulouse